Merge commit '0cda39255827f283e7578cd469ae42daad9556a2' from js2-mode

[gnu-emacs-elpa] / packages / ada-mode / ada-wisi.el

;;; ada-wisi.el --- Indentation engine for Ada mode, using the wisi generalized LALR parser  -*- lexical-binding:t -*-
;;
;; [1] ISO/IEC 8652:2012(E); Ada 2012 reference manual
;;
;; Copyright (C) 2012 - 2016  Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@member.fsf.org>
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
;;
;;; History:
;;
;; implementation started Jan 2013
;;
;;;;

(require 'ada-fix-error)
(require 'ada-grammar-wy)
(require 'ada-indent-user-options)
(require 'cl-lib)
(require 'wisi)

(defconst ada-wisi-class-list
  '(
    block-end
    block-middle ;; not start of statement
    block-start ;; start of block is start of statement
    close-paren
    list-break
    name
    name-paren ;; anything that looks like a procedure call, since the grammar can't distinguish most of them
    open-paren
    return
    return-with-params
    return-without-params
    statement-end
    statement-other
    statement-start
    ))

;;;; indentation

(defun ada-wisi-current-indentation ()
  "Return indentation appropriate for point on current line:
if not in paren, beginning of line
if in paren, pos following paren."
  (if (not (ada-in-paren-p))
      (current-indentation)

    (or
     (save-excursion
       (let ((line (line-number-at-pos)))
         (ada-goto-open-paren 1)
         (when (= line (line-number-at-pos))
           (current-column))))
     (save-excursion
       (back-to-indentation)
       (current-column)))
    ))

(defun ada-wisi-indent-cache (offset cache)
  "Return indentation of OFFSET plus indentation of line containing point. Point must be at CACHE."
  (let ((indent (current-indentation)))
    (cond
     ;; special cases
     ;;
     ((eq 'LEFT_PAREN (wisi-cache-token cache))
      ;; test/ada_mode-long_paren.adb
      ;; (RT                            => RT,
      ;;  Monitor                       => True,
      ;;  RX_Enable                     =>
      ;;    (RX_Torque_Subaddress |
      ;;   indenting '(RX_'
      ;;
      ;; test/ada_mode-parens.adb
      ;; return Float (
      ;;               Integer'Value
      ;;                 (Local_6));
      ;;   indenting '(local_6)'; 'offset' = ada-indent - 1
      (+ (current-column) 1 offset))

     ((save-excursion
        (let ((containing (wisi-goto-containing-paren cache)))
          (and containing
               ;; test/ada_mode-conditional_expressions.adb
               ;; K2 : Integer := (if J > 42
               ;;                  then -1
               ;;   indenting 'then'; offset = 0
               ;;
               ;; L1 : Integer := (case J is
               ;;                     when 42 => -1,
               ;;
               ;; test/indent.ads
               ;; C_S_Controls : constant
               ;;   CSCL_Type :=
               ;;     CSCL_Type'
               ;;       (
               ;;        1 =>  --  Used to be aligned on "CSCL_Type'"
               ;;              --  aligned with previous comment.
               ;;          IO_CPU_Control_State_S_Pkg.CPU2_Fault_Status_Type'
               ;;            (Unused2  => 10,  -- Used to be aligned on "1 =>"
               ;;  indenting '(Unused2'
               (+ (current-column) offset)))))

     ;; all other structures
     (t
      ;; current cache may be preceded by something on same
      ;; line. Handle common cases nicely.
      (while (and cache
                  (or
                   (not (= (current-column) indent))
                   (eq 'EQUAL_GREATER (wisi-cache-token cache))))
        (when (and
               (eq 'WHEN (wisi-cache-token cache))
               (not (eq 'exit_statement (wisi-cache-nonterm cache))))
          (setq offset (+ offset ada-indent-when)))
        (setq cache (wisi-goto-containing cache))
        (setq indent (current-indentation)))

      (cond
       ((null cache)
        ;; test/ada_mode-opentoken.ads
        ;; private package GDS.Commands.Add_Statement is
        ;;    type Instance is new Nonterminal.Instance with null record;
        ;;
        ;; test/ada_mode-nominal.adb
        ;;     return B : Integer :=
        ;;       (Local_Function);
        (+ indent offset))

       ((eq 'label_opt (wisi-cache-token cache))
        (+ indent (- ada-indent-label) offset))

       (t
        ;; test/ada_mode-generic_instantiation.ads
        ;; function Function_1 is new Instance.Generic_Function
        ;;   (Param_Type  => Integer,
        ;;
        ;; test/ada_mode-nested_packages.adb
        ;; function Create (Model   : in Integer;
        ;;                  Context : in String) return String is
        ;;    ...
        ;;    Cache : array (1 .. 10) of Boolean := (True, False, others => False);
        (+ indent offset))
       ))
     )))

(defun ada-wisi-indent-containing (offset cache &optional before)
  "Return indentation of OFFSET plus indentation of token containing CACHE.
BEFORE should be t when called from ada-wisi-before-cache, nil otherwise."
  (save-excursion
    (cond
     ((markerp (wisi-cache-containing cache))
      (ada-wisi-indent-cache offset (wisi-goto-containing cache)))

     (t
      (cond
       ((ada-in-paren-p)
        (ada-goto-open-paren 1)
        (+ (current-column) offset))

       (t
        ;; at outermost containing statement. If called from
        ;; ada-wisi-before-cache, we want to ignore OFFSET (indenting
        ;; 'package' in a package spec). If called from
        ;; ada-wisi-after-cache, we want to include offset (indenting
        ;; first declaration in the package).
        (if before 0 offset))
       ))
      )))

(defun ada-wisi-indent-list-break (cache prev-token)
  "Return indentation for a token contained by CACHE, which must be a list-break.
point must be on CACHE. PREV-TOKEN is the token before the one being indented."
  (let ((break-point (point))
        (containing (wisi-goto-containing cache)))
    (cl-ecase (wisi-cache-token containing)
      (LEFT_PAREN
       (if (equal break-point (cadr prev-token))
           ;; we are indenting the first token after the list-break; not hanging.
           ;;
           ;; test/parent.adb
           ;; Append_To (Formals,
           ;;            Make_Parameter_Specification (Loc,
           ;; indenting 'Make_...'
           ;;
           ;; test/ada_mode-generic_instantiation.ads
           ;; function Function_1 is new Instance.Generic_Function
           ;;   (Param_Type  => Integer,
           ;;    Result_Type => Boolean,
           ;;    Threshold   => 2);
           ;; indenting 'Result_Type'
           (+ (current-column) 1)
         ;; else hanging
         ;;
         ;; test/ada_mode-parens.adb
         ;; A :=
         ;;   (1 |
         ;;      2 => (1, 1, 1),
         ;;    3 |
         ;;      4 => (2, 2, 2));
         ;; indenting '4 =>'
         (+ (current-column) 1 ada-indent-broken)))

      (IS
       ;; test/ada_mode-conditional_expressions.adb
       ;; L1 : Integer := (case J is
       ;;                     when 42 => -1,
       ;;                     -- comment aligned with 'when'
       ;; indenting '-- comment'
       (wisi-indent-paren (+ 1 ada-indent-when)))

      (WITH
       (cl-ecase (wisi-cache-nonterm containing)
         (aggregate
          ;; test/ada_mode-nominal-child.ads
          ;; (Default_Parent with
          ;;  Child_Element_1 => 10,
          ;;  Child_Element_2 => 12.0,
          ;; indenting 'Child_Element_2'
          (wisi-indent-paren 1))

         (aspect_specification_opt
          ;; test/aspects.ads:
          ;; type Vector is tagged private
          ;; with
          ;;   Constant_Indexing => Constant_Reference,
          ;;   Variable_Indexing => Reference,
          ;; indenting 'Variable_Indexing'
          (+ (current-indentation) ada-indent-broken))
         ))
      )
    ))

(defun ada-wisi-before-cache ()
  "Point is at indentation, before a cached token. Return new indentation for point."
  (let ((pos-0 (point))
        (cache (wisi-get-cache (point)))
        (prev-token (save-excursion (wisi-backward-token)))
        )
    (when cache
      (cl-ecase (wisi-cache-class cache)
        (block-start
         (cl-case (wisi-cache-token cache)
           (IS ;; subprogram body
            (ada-wisi-indent-containing 0 cache t))

           (RECORD
            ;; test/ada_mode-nominal.ads; ada-indent-record-rel-type = 3
            ;; type Private_Type_2 is abstract tagged limited
            ;;    record
            ;; indenting 'record'
            ;;
            ;; type Limited_Derived_Type_1d is
            ;;    abstract limited new Private_Type_1 with
            ;;    record
            ;; indenting 'record'
            ;;
            ;; for Record_Type_1 use
            ;;   record
            ;;   indenting 'record'
            (let ((containing (wisi-goto-containing cache)))
              (while (not (memq (wisi-cache-token containing) '(FOR TYPE)))
                (setq containing (wisi-goto-containing containing)))
              (+ (current-column) ada-indent-record-rel-type)))

           (t ;; other
            (ada-wisi-indent-containing ada-indent cache t))))

        (block-end
         (cl-case (wisi-cache-nonterm cache)
           (record_definition
            (save-excursion
              (wisi-goto-containing cache);; now on 'record'
              (current-indentation)))

           (t
            (ada-wisi-indent-containing 0 cache t))
           ))

        (block-middle
         (cl-case (wisi-cache-token cache)
           (WHEN
            (ada-wisi-indent-containing ada-indent-when cache t))

           (t
            (ada-wisi-indent-containing 0 cache t))
           ))

        (close-paren (wisi-indent-paren 0))

        (keyword
         ;; defer to after-cache)
         nil)

        (list-break
        ;; test/ada_mode-parens.adb
         ;; Foo (X
         ;;        ,    --  used to get an error here; don't care about the actual indentation
         ;; indenting ','
         ;;
         ;; We don't actually care what the indentation is, since this
         ;; should only occur while editing; defer to after-cache
         ;; avoids an error and does something reasonable.
         nil)

        (name
         (cond
          ((let ((temp (save-excursion (wisi-goto-containing cache))))
             (and temp
                  (memq (wisi-cache-nonterm temp) '(subprogram_body subprogram_declaration))))
           ;; test/ada_mode-nominal.ads
           ;; not
           ;; overriding
           ;; procedure
           ;;   Procedure_1c (Item  : in out Parent_Type_1);
           ;; indenting 'Procedure_1c'
           ;;
           ;; not overriding function
           ;;   Function_2e (Param : in Parent_Type_1) return Float;
           ;; indenting 'Function_2e'
           (ada-wisi-indent-containing ada-indent-broken cache t))

          (t
           ;; defer to ada-wisi-after-cache, for consistency
           nil)
          ))

        (name-paren
         ;; defer to ada-wisi-after-cache, for consistency
         nil)

        (open-paren
         (let* ((containing (wisi-goto-containing cache))
                (containing-pos (point)))
           (cl-case (wisi-cache-token containing)
             (COMMA
              ;; test/ada_mode-parens.adb
              ;; A : Matrix_Type :=
              ;;   ((1, 2, 3),
              ;;    (4, 5, 6),
              ;; indenting (4; containing is '),' ; 0
              ;;
              ;; test/ada_mode-parens.adb
              ;; Local_14 : Local_14_Type :=
              ;;   ("123",
              ;;    "456" &
              ;;    ("789"));
              ;; indenting ("4"; contaning is '3",' ; ada-indent-broken

              (ada-wisi-indent-containing
               (if (= (nth 1 prev-token) containing-pos) 0 ada-indent-broken)
               containing))

             (EQUAL_GREATER
              (setq containing (wisi-goto-containing containing))
              (cl-ecase (wisi-cache-token containing)
                (COMMA
                 ;; test/ada_mode-long_paren.adb
                 ;; (RT                            => RT,
                 ;;  Monitor                       => True,
                 ;;  RX_Enable                     =>
                 ;;    (RX_Torque_Subaddress |
                 ;; indenting (RX_Torque
                 (ada-wisi-indent-containing ada-indent-broken containing t))
                (LEFT_PAREN
                 ;; test/ada_mode-parens.adb
                 ;; (1 =>
                 ;;    (1 => 12,
                 ;; indenting '(1 => 12'; containing is '=>'
                 (ada-wisi-indent-cache (1- ada-indent) containing))
                (WHEN
                 ;; test/ada_mode-conditional_expressions.adb
                 ;;  when 1 =>
                 ;;    (if J > 42
                 ;; indenting '(if'; containing is '=>'
                 (+ (current-column) -1 ada-indent))
                (WITH
                 ;; test/aspects.ads
                 ;;    function Wuff return Boolean with Pre =>
                 ;;      (for all x in U =>
                 ;; indenting '(for';  containing is '=>', 'with', 'function'
                 (ada-wisi-indent-cache (1- ada-indent) containing))
                ))

             ((FUNCTION PROCEDURE)
              ;; test/ada_mode-nominal.adb
              ;; function Function_Access_11
              ;;   (A_Param : in Float)
              ;;   --  EMACSCMD:(test-face "function" font-lock-keyword-face)
              ;;   return access function
              ;;     (A_Param : in Float)
              ;;     return
              ;;     Standard.Float -- Ada mode 4.01, GPS do this differently
              ;; indenting second '(A_Param)
              (+ (current-indentation) -1 ada-indent))

             (LEFT_PAREN
              ;; test/ada_mode-parens.adb
              ;; or else ((B.all
              ;;             and then C)
              ;;            or else
              ;;            (D
              ;; indenting (D
              (+ (current-column) 1 ada-indent-broken))

             (WHEN
              ;; test/ada_mode-nominal.adb
              ;;
              ;; when Local_1 = 0 and not
              ;;   (Local_2 = 1)
              ;; indenting (Local_2
              ;;
              ;; entry E3
              ;;   (X : Integer) when Local_1 = 0 and not
              ;;     (Local_2 = 1)
              (+ (ada-wisi-current-indentation) ada-indent-broken))

             ((IDENTIFIER selected_component name)
              ;; test/indent.ads
              ;; CSCL_Type'
              ;;   (
              ;; identing (
              ;;
              ;; test/ada_mode-parens.adb
              ;; Check
              ;;   ("foo bar",
              ;;    A
              ;;      (1),
              ;;    A(2));
              ;; indenting (1)
              ;;
              ;; test/ada_mode-parens.adb
              ;; Local_11 : Local_11_Type := Local_11_Type'
              ;;   (A => Integer
              ;;      (1.0),
              ;;    B => Integer
              ;;      (2.0));
              ;;
              ;; test/ada_mode-parens.adb
              ;; Local_12 : Local_11_Type
              ;;   := Local_11_Type'(A => Integer
              ;;     (1.0),
              ;; indenting (1.0)
              (+ (ada-wisi-current-indentation) ada-indent-broken))

             (t
              (cond
                ((memq (wisi-cache-class containing) '(block-start statement-start))
                 ;; test/ada_mode-nominal.adb
                 ;; entry E2
                 ;;   (X : Integer)
                 ;; indenting (X
                 (ada-wisi-indent-cache ada-indent-broken containing))

                (t
                 ;; Open paren in an expression.
                 ;;
                 ;; test/ada_mode-conditional_expressions.adb
                 ;; L0 : Integer :=
                 ;;   (case J is when 42 => -1, when Integer'First .. 41 => 0, when others => 1);
                 ;; indenting (case
                 (ada-wisi-indent-containing ada-indent-broken containing t))
                ))
             )))

        (return-with-params;; parameter list
         (let ((return-pos (point)))
           (wisi-goto-containing cache nil) ;; matching 'function'
           (cond
            ((<= ada-indent-return 0)
             ;; indent relative to "("
             (wisi-forward-find-class 'open-paren return-pos)
             (+ (current-column) (- ada-indent-return)))

            (t
             (+ (current-column) ada-indent-return))
            )))

        (return-without-params;; no parameter list
         (wisi-goto-containing cache nil) ;; matching 'function'
         (+ (current-column) ada-indent-broken))

        (statement-end
         (ada-wisi-indent-containing ada-indent-broken cache t))

        (statement-other
         (save-excursion
           (let ((containing (wisi-goto-containing cache nil)))
             (while (not (wisi-cache-nonterm containing))
               (setq containing (wisi-goto-containing containing)))

             (cond
              ;; cases to defer to after-cache
              ((and
                (eq (wisi-cache-nonterm cache) 'qualified_expression)
                ;; test/ada_mode-parens.adb Local_13 Integer'
                (not (eq (wisi-cache-token containing) 'COLON_EQUAL)))
               ;; _not_ test/indent.ads CSCL_Type'
               nil)

              ;; handled here
              (t
               (cl-case (wisi-cache-token cache)
                 (EQUAL_GREATER
                  (+ (current-column) ada-indent-broken))

                 (ELSIF
                  ;; test/g-comlin.adb
                  ;;   elsif Current_Argument < CL.Argument_Count then
                  (ada-wisi-indent-cache 0 containing))

                 (RENAMES
                  (cl-ecase (wisi-cache-nonterm containing)
                    ((generic_renaming_declaration subprogram_renaming_declaration)
                     (wisi-forward-find-token '(FUNCTION PROCEDURE) pos-0)
                     (let ((pos-subprogram (point))
                           (has-params
                            ;; this is wrong for one return access
                            ;; function case: overriding function Foo
                            ;; return access Bar (...) renames ...;
                            (wisi-forward-find-token 'LEFT_PAREN pos-0 t)))
                       (if has-params
                           (if (<= ada-indent-renames 0)
                               ;; indent relative to paren
                               (+ (current-column) (- ada-indent-renames))
                             ;; else relative to line containing keyword
                             (goto-char pos-subprogram)
                             (+ (current-indentation) ada-indent-renames))

                         ;; no params
                         (goto-char pos-subprogram)
                         (+ (current-indentation) ada-indent-broken))
                       ))

                    (object_renaming_declaration
                     (+ (current-indentation) ada-indent-broken))
                    ))

                 (t
                  (cl-ecase (wisi-cache-nonterm containing)
                    (aggregate
                     ;; test/ada_mode-nominal-child.adb
                     ;; return (Parent_Type_1
                     ;;         with 1, 0.0, False);
                     ;; indenting 'with'; containing is '('
                     (+ (current-column) 1))

                    (component_declaration
                     ;; test/ada_mode-nominal.ads Record_Type_3 ':'
                     (+ (current-column) ada-indent-broken))

                    (entry_body
                     ;; test/ada_mode-nominal.adb
                     ;; entry E2
                     ;;   (X : Integer)
                     ;;   when Local_1 = 0 and not
                     ;; indenting 'when'; containing is 'entry'
                     (+ (current-column) ada-indent-broken))

                    (formal_package_declaration
                     ;; test/ada_mode-generic_package.ads
                     ;; with package A_Package_7 is
                     ;;   new Ada.Text_IO.Integer_IO (Num => Formal_Signed_Integer_Type);
                     ;; indenting 'new'; containing is 'with'
                     (+ (current-column) ada-indent-broken))

                    ((full_type_declaration
                      protected_type_declaration
                      single_protected_declaration
                      single_task_declaration
                      subtype_declaration
                      task_type_declaration)

                     (while (not (memq (wisi-cache-token containing) '(PROTECTED SUBTYPE TASK TYPE)))
                       (setq containing (wisi-goto-containing containing)))

                     (cond
                      ((eq (wisi-cache-token cache) 'WITH)
                       (let ((type-col (current-column))
                             (null_private (save-excursion (wisi-goto-end-1 cache)
                                                           (eq 'WITH (wisi-cache-token (wisi-backward-cache))))))
                         (cond
                          ((eq 'aspect_specification_opt (wisi-cache-nonterm cache))
                           ;; test/aspects.ads
                           ;; subtype Integer_String is String
                           ;;   with Dynamic_Predicate => Integer'Value (Integer_String) in Integer
                           ;; indenting 'with'
                           ;;
                           ;; test/ada_mode.ads
                           ;; protected Separate_Protected_Body
                           ;; with
                           ;;   Priority => 5
                           ;; indenting 'with'
                           ;;
                           ;; test/ada_nominal.ads
                           ;; task type Task_Type_1 (Name : access String)
                           ;; with
                           ;;    Storage_Size => 512 + 256
                           ;; indenting 'with'
                           type-col)

                          (null_private
                           ;; 'with null record;' or 'with private;'
                           ;; test/ada_mode-nominal.ads
                           ;; type Limited_Derived_Type_3 is abstract limited new Private_Type_1
                           ;;   with null record;
                           ;; indenting 'with'; containing is 'is'
                           (+ type-col ada-indent-broken))

                          (t
                           ;; test/ada_mode-nominal.ads
                           ;; type Unconstrained_Array_Type_3 is array (Integer range <>, Standard.Character range <>)
                           ;;   of Object_Access_Type_1;
                           ;; indenting 'of'; containing is 'is'
                           ;;
                           ;; type Object_Access_Type_7
                           ;;   is access all Integer;
                           ;; indenting 'is'; containing is 'type'
                           (+ type-col ada-indent-record-rel-type)))))

                      (t
                       ;; test/ada_mode-nominal.ads
                       ;; type Limited_Derived_Type_2a is abstract limited new Private_Type_1
                       ;;   with record
                       ;; indenting 'with record'
                       ;;
                       ;; test/access_in_record.ads
                       ;; type A
                       ;;    is new Ada.Streams.Root_Stream_Type with record
                       ;;
                       ;; test/adacore_9717_001.ads A_Long_Name
                       ;; subtype A_Long_Name
                       ;;   is Ada.Text_Io.Count;
                       ;; indenting 'is'
                       (+ (current-column) ada-indent-broken))
                      ))

                    (generic_instantiation
                     ;; test/ada_mode-generic_instantiation.ads
                     ;; procedure Procedure_7 is
                     ;;   new Instance.Generic_Procedure (Integer, Function_1);
                     ;; indenting 'new'
                     (+ (current-column) ada-indent-broken))

                    (generic_renaming_declaration
                     ;; indenting keyword following 'generic'
                     (current-column))

                    (object_declaration
                     (cl-ecase (wisi-cache-token containing)
                       (COLON
                        ;; test/ada_mode-nominal.ads
                        ;; Anon_Array_3 : array (1 .. 10)
                        ;;   of Integer;
                        ;; indenting 'of'
                        (+ (current-indentation) ada-indent-broken))

                       (COLON_EQUAL
                        ;; test/indent.ads
                        ;; C_S_Controls : constant
                        ;;   CSCL_Type :=
                        ;;     CSCL_Type'
                        ;; indenting 'CSCL_Type'
                        (+ (current-indentation) ada-indent-broken))

                       (identifier_list
                        ;; test/ada_mode-nominal.adb
                        ;; Local_2 : constant Float
                        ;;   := Local_1;
                        (+ (current-indentation) ada-indent-broken))
                       ))

                    (private_extension_declaration
                     (cl-ecase (wisi-cache-token cache)
                       (WITH
                        ;; test/aspects.ads
                        ;; type Date_Set is tagged private
                        ;; with
                        ;; indenting 'with'
                        (current-indentation))

                       (t
                        ;; test/ada_mode-nominal.ads
                        ;; type Limited_Derived_Type_3 is abstract limited
                        ;;   new Private_Type_1 with private;
                        ;; indenting 'new'
                        (+ (current-indentation) ada-indent-broken))
                       ))

                    (private_type_declaration
                     ;; test/aspects.ads
                     ;; type Vector is tagged private
                     ;; with
                     ;; indenting 'with'
                     (current-indentation))

                    (qualified_expression
                     ;; test/ada_mode-nominal-child.ads
                     ;; Child_Obj_5 : constant Child_Type_1 :=
                     ;;   (Parent_Type_1'
                     ;;     (Parent_Element_1 => 1,
                     (ada-wisi-indent-cache ada-indent-broken containing))

                    (statement
                     (cl-case (wisi-cache-token containing)
                       (label_opt
                        (- (current-column) ada-indent-label))

                       (t
                        ;; test/ada_mode-nominal.adb
                        ;; select
                        ;;    delay 1.0;
                        ;; then
                        ;;    -- ...
                        ;;   abort
                        (ada-wisi-indent-cache ada-indent-broken cache))
                       ))

                    ((abstract_subprogram_declaration
                      expression_function_declaration
                      subprogram_body
                      subprogram_declaration
                      subprogram_specification
                      null_procedure_declaration)
                     (cl-ecase (wisi-cache-token cache)
                       (IS
                        ;; test/ada_mode-nominal.ads
                        ;; procedure Procedure_1d
                        ;;   (Item   : in out Parent_Type_1;
                        ;;    Item_1 : in     Character;
                        ;;    Item_2 : out    Character)
                        ;;   is null;
                        ;; indenting 'is'
                        (+ (current-column) ada-indent-broken))

                       (OVERRIDING
                        ;; indenting 'overriding' following 'not'
                        (current-column))

                       ((PROCEDURE FUNCTION)
                        ;; indenting 'procedure' or 'function following 'overriding'
                        (current-column))

                       (WITH
                        ;; indenting aspect specification on subprogram declaration
                        ;; test/aspects.ads
                        ;; procedure Foo (X : Integer;
                        ;;                Y : out Integer)
                        ;; with Pre => X > 10 and
                        ;; indenting 'with'
                        (current-column))
                       ))

                    ))))
              )))) ;; end statement-other

        (statement-start
         (cond
          ((eq 'label_opt (wisi-cache-token cache))
           (ada-wisi-indent-containing (+ ada-indent-label ada-indent) cache t))

          (t
           (let ((containing-cache (wisi-get-containing-cache cache)))
             (if (not containing-cache)
                 ;; at bob
                 0
               ;; not at bob
               (cl-case (wisi-cache-class containing-cache)
                 ((block-start block-middle)
                  (wisi-goto-containing cache)
                  (cl-case (wisi-cache-nonterm containing-cache)
                    (record_definition
                     (+ (current-indentation) ada-indent))

                    (t
                     (ada-wisi-indent-cache ada-indent containing-cache))
                    ))

                 (list-break
                  (ada-wisi-indent-list-break cache prev-token))

                 ))))
             ))
        ))
    ))

(defun ada-wisi-after-cache ()
  "Point is at indentation, not before a cached token. Find previous
cached token, return new indentation for point."
  (save-excursion
    (let ((start (point))
          (prev-token (save-excursion (wisi-backward-token)))
          (cache (wisi-backward-cache)))

      (cond
       ((not cache) ;; bob
        0)

       (t
        (while (memq (wisi-cache-class cache) '(keyword name name-paren type))
          ;; not useful for indenting
          (setq cache (wisi-backward-cache)))

        (cl-ecase (wisi-cache-class cache)
          (block-end
           ;; indenting block/subprogram name after 'end'
           (wisi-indent-current ada-indent-broken))

          (block-middle
           (cl-case (wisi-cache-token cache)
             (IS
              (cl-case (wisi-cache-nonterm cache)
                (case_statement
                 ;; between 'case .. is' and first 'when'; most likely a comment
                 (ada-wisi-indent-containing 0 cache t))

                (t
                 (+ (ada-wisi-indent-containing ada-indent cache t)))
                ))

             ((THEN ELSE)
              ;;
              ;; test/ada_mode-conditional_expressions.adb
              ;; K3 : Integer := (if
              ;;                    J > 42
              ;;                  then
              ;;                    -1
              ;;                  else
              ;;                    +1);
              ;; indenting -1, +1
              (let ((indent
                     (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
                       ((statement if_statement elsif_statement_item) ada-indent)
                       ((if_expression elsif_expression_item) ada-indent-broken))))
                (ada-wisi-indent-containing indent cache t)))

             (WHEN
              ;; between 'when' and '=>'
              (+ (current-column) ada-indent-broken))

             (t
              ;; block-middle keyword may not be on separate line:
              ;;       function Create (Model   : in Integer;
              ;;                        Context : in String) return String is
              (ada-wisi-indent-containing ada-indent cache nil))
             ))

          (block-start
           (cl-case (wisi-cache-nonterm cache)
             (exception_handler
              ;; between 'when' and '=>'
              (+ (current-column) ada-indent-broken))

             (if_expression
              (ada-wisi-indent-containing ada-indent-broken cache nil))

             (select_alternative
              (ada-wisi-indent-containing (+ ada-indent-when ada-indent-broken) cache nil))

             (t ;; other; normal block statement
              (ada-wisi-indent-cache ada-indent cache))
             ))

          (close-paren
           ;; actual_parameter_part: test/ada_mode-nominal.adb
           ;; return 1.0 +
           ;;   Foo (Bar) + -- multi-line expression that happens to have a cache at a line start
           ;;   12;
           ;; indenting '12'; don't indent relative to containing function name
           ;;
           ;; attribute_designator: test/ada_mode-nominal.adb
           ;; raise Constraint_Error with Count'Image (Line (File)) &
           ;;    "foo";
           ;; indenting '"foo"'; relative to raise
           ;;
           ;; test/ada_mode-slices.adb
           ;; Put_Line(Day'Image(D1) & " - " & Day'Image(D2) & " = " &
           ;;            Integer'Image(N));
           ;; indenting 'Integer'
           (when (memq (wisi-cache-nonterm cache)
                       '(actual_parameter_part attribute_designator))
             (setq cache (wisi-goto-containing cache)))
           (ada-wisi-indent-containing ada-indent-broken cache nil))

          (list-break
           (ada-wisi-indent-list-break cache prev-token))

          (open-paren
           ;; 1) A parenthesized expression, or the first item in an aggregate:
           ;;
           ;;    (foo +
           ;;       bar)
           ;;    (foo =>
           ;;       bar)
           ;;
           ;;     we are indenting 'bar'
           ;;
           ;; 2) A parenthesized expression, or the first item in an
           ;;    aggregate, and there is whitespace between
           ;;    ( and the first token:
           ;;
           ;; test/ada_mode-parens.adb
           ;; Local_9 : String := (
           ;;                      "123"
           ;;
           ;; 3) A parenthesized expression, or the first item in an
           ;;    aggregate, and there is a comment between
           ;;    ( and the first token:
           ;;
           ;; test/ada_mode-nominal.adb
           ;; A :=
           ;;   (
           ;;    -- a comment between paren and first association
           ;;    1 =>
           ;;
           ;; test/ada_mode-parens.adb
           ;; return Float (
           ;;               Integer'Value
           ;; indenting 'Integer'
           (let ((paren-column (current-column))
                 (start-is-comment (save-excursion (goto-char start) (looking-at comment-start-skip))))
             (wisi-forward-token); point is now after paren
             (if start-is-comment
                 (skip-syntax-forward " >"); point is now on comment
               (forward-comment (point-max)); point is now on first token
               )
             (if (= (point) start)
                 ;; case 2) or 3)
                 (1+ paren-column)
               ;; 1)
               (+ paren-column 1 ada-indent-broken))))

          ((return-with-params return-without-params)
           ;; test/ada_mode-nominal.adb
           ;; function Function_Access_1
           ;;   (A_Param : in Float)
           ;;   return
           ;;     Standard.Float
           ;; indenting 'Standard.Float'
           ;;
           ;; test/ada_mode-expression_functions.ads
           ;; function Square (A : in Float) return Float
           ;;   is (A * A);
           ;; indenting 'is'
           ;;
           ;; test/ada_mode-nominal.ads
           ;; function Function_2g
           ;;   (Param : in Private_Type_1)
           ;;   return Float
           ;;   is abstract;
           ;; indenting 'is'
           (back-to-indentation)
           (+ (current-column) ada-indent-broken))

          (statement-end
           (ada-wisi-indent-containing 0 cache nil))

          (statement-other
           (cl-ecase (wisi-cache-token cache)
             (ABORT
              ;; select
              ;;    Please_Abort;
              ;; then
              ;;   abort
              ;;    -- 'abort' indented with ada-indent-broken, since this is part
              ;;    Titi;
              (ada-wisi-indent-containing ada-indent cache))

             ;; test/subdir/ada_mode-separate_task_body.adb
             ((COLON COLON_EQUAL)
              ;; Local_3 : constant Float :=
              ;;   Local_2;
              ;;
              ;; test/ada_mode-nominal.ads
              ;; type Record_Type_3 (Discriminant_1 : access Integer) is tagged record
              ;;    Component_1 : Integer; -- end 2
              ;;    Component_2 :
              ;;      Integer;
              ;; indenting 'Integer'; containing is ';'
              (ada-wisi-indent-cache ada-indent-broken cache))

             (COMMA
              (cl-ecase (wisi-cache-nonterm cache)
                (name_list
                 (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
                   (use_clause
                    ;; test/with_use1.adb
                    (ada-wisi-indent-containing ada-indent-use cache))

                   (with_clause
                    ;; test/ada_mode-nominal.ads
                    ;; limited private with Ada.Strings.Bounded,
                    ;;   --EMACSCMD:(test-face "Ada.Containers" 'default)
                    ;;   Ada.Containers;
                    ;;
                    ;; test/with_use1.adb
                    (ada-wisi-indent-containing ada-indent-with cache))
                   ))
                ))

             (ELSIF
              ;; test/g-comlin.adb
              ;; elsif Index_Switches + Max_Length <= Switches'Last
              ;;   and then Switches (Index_Switches + Max_Length) = '?'
              (ada-wisi-indent-cache ada-indent-broken cache))

             (EQUAL_GREATER
              (let ((cache-col (current-column))
                    (cache-pos (point))
                    (line-end-pos (line-end-position))
                    (containing (wisi-goto-containing cache nil)))
                (while (eq (wisi-cache-nonterm containing) 'association_list)
                  (setq containing (wisi-goto-containing containing nil)))

                (cl-ecase (wisi-cache-nonterm containing)
                  ((actual_parameter_part aggregate)
                   ;; ada_mode-generic_package.ads
                   ;; with package A_Package_2 is new Ada.Text_IO.Integer_IO (Num =>
                   ;;                                                           Formal_Signed_Integer_Type);
                   ;;  indenting 'Formal_Signed_...', point on '(Num'
                   ;;
                   ;; test/ada_mode-parens.adb
                   ;; (1      =>
                   ;;    1,
                   ;;  2      =>
                   ;;    1 + 2 * 3,
                   ;; indenting '1,' or '1 +'; point on '(1'
                   ;;
                   ;; test/ada_mode-parens.adb
                   ;; Local_13 : Local_11_Type
                   ;;   := (Integer'(1),
                   ;;       Integer'(2));
                   ;; indenting 'Integer'; point on '(Integer'
                   (+ (current-column) 1 ada-indent-broken))

                  (aspect_specification_opt
                   ;; test/aspects.ads
                   ;; with Pre => X > 10 and
                   ;;             X < 50 and
                   ;;             F (X),
                   ;;   Post =>
                   ;;     Y >= X and
                   ;; indenting 'X < 50' or 'Y >= X'; cache is '=>', point is on '=>'
                   ;; or indenting 'Post =>'; cache is ',', point is on 'with'
                   (cl-ecase (wisi-cache-token cache)
                     (COMMA
                      (+ (current-indentation) ada-indent-broken))

                     (EQUAL_GREATER
                      (if (= (+ 2 cache-pos) line-end-pos)
                          ;;   Post =>
                          ;;     Y >= X and
                          (progn
                            (goto-char cache-pos)
                            (+ (current-indentation) ada-indent-broken))
                        ;; with Pre => X > 10 and
                        ;;             X < 50 and
                        (+ 3 cache-col)))
                     ))

                  (association_list
                   (cl-ecase (save-excursion (wisi-cache-token (wisi-goto-containing cache nil)))
                     (COMMA
                      (ada-wisi-indent-containing (* 2 ada-indent-broken) cache))
                     ))

                  ((case_expression_alternative case_statement_alternative exception_handler)
                   ;; containing is 'when'
                   (+ (current-column) ada-indent))

                  (generic_renaming_declaration
                   ;; not indenting keyword following 'generic'
                   (+ (current-column) ada-indent-broken))

                  (primary
                   ;; test/ada_mode-quantified_expressions.adb
                   ;; if (for some J in 1 .. 10 =>
                   ;;       J/2 = 0)
                   (ada-wisi-indent-containing ada-indent-broken cache))


                  (select_alternative
                   ;; test/ada_mode-nominal.adb
                   ;; or when Started
                   ;;      =>
                   ;;       accept Finish;
                   ;; indenting 'accept'; point is on 'when'
                   (+ (current-column) ada-indent))

                  (variant
                   ;; test/generic_param.adb
                   ;; case Item_Type is
                   ;;    when Fix | Airport =>
                   ;;       null;
                   ;; indenting 'null'
                   (+ (current-column) ada-indent))

                  )))

             (IS
              (setq cache (wisi-goto-containing cache))
              (cl-ecase (wisi-cache-nonterm cache)
                (full_type_declaration
                 ;; ada_mode/nominal.ads
                 ;; type Limited_Derived_Type_1a is abstract limited new
                 ;;    Private_Type_1 with record
                 ;;       Component_1 : Integer;
                 ;; indenting 'Private_Type_1'; look for 'record'
                 (let ((type-column (current-column)))
                   (goto-char start)
                   (if (wisi-forward-find-token 'RECORD (line-end-position) t)
                       ;; 'record' on line being indented
                       (+ type-column ada-indent-record-rel-type)
                     ;; 'record' on later line
                     (+ type-column ada-indent-broken))))

                ((formal_type_declaration
                  ;; test/ada_mode-generic_package.ads
                  ;; type Synchronized_Formal_Derived_Type is abstract synchronized new Formal_Private_Type and Interface_Type
                  ;;   with private;

                  subtype_declaration
                  ;; test/ada_mode-nominal.ads
                  ;;    subtype Subtype_2 is Signed_Integer_Type range 10 ..
                  ;;      20;

                  private_type_declaration
                  ;; type Private_Type_2 is abstract tagged limited
                  ;;  private;
                  )
                 (+ (current-column) ada-indent-broken))

                (null_procedure_declaration
                 ;; ada_mode-nominal.ads
                 ;; procedure Procedure_3b is
                 ;;   null;
                 ;; indenting null
                 (+ (current-column) ada-indent-broken))

                ))

             (LEFT_PAREN
              ;; test/indent.ads
              ;; C_S_Controls : constant
              ;;   CSCL_Type :=
              ;;     CSCL_Type'
              ;;       (
              ;;        1 =>
              (+ (current-column) 1))

             (NEW
              ;; ada_mode-nominal.ads
              ;; type Limited_Derived_Type_2 is abstract limited new Private_Type_1 with
              ;;   private;
              ;;
              ;; test/ada_mode-generic_instantiation.ads
              ;;   procedure Procedure_6 is new
              ;;     Instance.Generic_Procedure (Integer, Function_1);
              ;; indenting 'Instance'; containing is 'new'
              (ada-wisi-indent-containing ada-indent-broken cache))

             (OF
              ;; ada_mode-nominal.ads
              ;; Anon_Array_2 : array (1 .. 10) of
              ;;   Integer;
              (ada-wisi-indent-containing ada-indent-broken cache))

             (WHEN
              ;; test/ada_mode-parens.adb
              ;; exit when A.all
              ;;   or else B.all
              (ada-wisi-indent-containing ada-indent-broken cache))

             (WITH
              (cl-ecase (wisi-cache-nonterm cache)
                (aggregate
                 ;; test/ada_mode-nominal-child.ads
                 ;;   (Default_Parent with
                 ;;    10, 12.0, True);
                 ;; indenting '10'; containing is '('
                 (ada-wisi-indent-containing 0 cache nil))

                (aspect_specification_opt
                 ;; test/aspects.ads
                 ;; type Vector is tagged private
                 ;; with
                 ;;   Constant_Indexing => Constant_Reference,
                 ;; indenting 'Constant_Indexing'; point is on 'with'
                 (+ (current-indentation) ada-indent-broken))
                ))

             ;; otherwise just hanging
             ((ACCEPT FUNCTION PROCEDURE RENAMES)
              (back-to-indentation)
              (+ (current-column) ada-indent-broken))

             ))

          (statement-start
           (cl-case (wisi-cache-token cache)
             (WITH ;; with_clause
              (+ (current-column) ada-indent-with))

             (label_opt
              ;; comment after label
              (+ (current-column) (- ada-indent-label)))

             (t
              ;; procedure Procedure_8
              ;;   is new Instance.Generic_Procedure (Integer, Function_1);
              ;; indenting 'is'; hanging
              ;;
              ;; test/ada_mode-conditional_expressions.adb
              ;; K3 : Integer := (if
              ;;                    J > 42
              ;;                  then
              ;;                    -1
              ;;                  else
              ;;                    +1);
              ;; indenting J
              (ada-wisi-indent-cache ada-indent-broken cache))
             ))
          )))
      )))

(defun ada-wisi-comment ()
  "Compute indentation of a comment. For `wisi-indent-calculate-functions'."
  ;; We know we are at the first token on a line. We check for comment
  ;; syntax, not comment-start, to accomodate gnatprep, skeleton
  ;; placeholders, etc.
  (when (and (not (= (point) (point-max))) ;; no char after EOB!
             (= 11 (syntax-class (syntax-after (point)))))

    ;; We are at a comment; indent to previous code or comment.
    (cond
     ((and ada-indent-comment-col-0
           (= 0 (current-column)))
      0)

     ((or
       (save-excursion (forward-line -1) (looking-at "\\s *$"))
       (save-excursion (forward-comment -1)(not (looking-at comment-start))))
      ;; comment is after a blank line or code; indent as if code
      ;;
      ;; ada-wisi-before-cache will find the keyword _after_ the
      ;; comment, which could be a block-middle or block-end, and that
      ;; would align the comment with the block-middle, which is wrong. So
      ;; we only call ada-wisi-after-cache.

      (let ((indent (ada-wisi-after-cache))
            prev-indent next-indent)
        (if ada-indent-comment-gnat
          ;; match the gnat comment indent style check; comments must
          ;; be aligned to one of:
          ;;
          ;; - multiple of ada-indent
          ;; - next non-blank line
          ;; - previous non-blank line
          ;;
          ;; Note that we must indent the prev and next lines, in case
          ;; they are not currently correct.
          (cond
           ((= 0 (% indent ada-indent))
            ;; this will handle comments at bob and eob, so we don't
            ;; need to worry about those positions in the next checks.
            indent)

           ((and (setq prev-indent
                       (save-excursion (forward-line -1)(indent-according-to-mode)(current-indentation)))
                 (= indent prev-indent))
            indent)

           ((and (setq next-indent
                       ;; we use forward-comment here, instead of
                       ;; forward-line, because consecutive comment
                       ;; lines are indented to the current one, which
                       ;; we don't know yet.
                       (save-excursion (forward-comment (point-max))(indent-according-to-mode)(current-indentation)))
                 (= indent next-indent))
            indent)

           (t
            (or
             prev-indent
             next-indent
             (floor indent ada-indent)))
           )

          ;; not forcing gnat style
          indent)))

      (t
       ;; comment is after a comment
       (forward-comment -1)
       (current-column))
      )))

(defun ada-wisi-post-parse-fail ()
  "For `wisi-post-parse-fail-hook'."
  (save-excursion
    (let ((start-cache (wisi-goto-start (or (wisi-get-cache (point)) (wisi-backward-cache)))))
      (when start-cache
        ;; nil when in a comment at point-min
        (indent-region (point) (wisi-cache-end start-cache)))
      ))
  (back-to-indentation))

;;;; ada-mode functions (alphabetical)

(defun ada-wisi-declarative-region-start-p (cache)
  "Return t if cache is a keyword starting a declarative region."
  (cl-case (wisi-cache-token cache)
   (DECLARE t)
   (IS
    (memq (wisi-cache-class cache) '(block-start block-middle)))
   (t nil)
   ))

(defun ada-wisi-context-clause ()
  "For `ada-fix-context-clause'."
  (wisi-validate-cache (point-max))
  (save-excursion
    (goto-char (point-min))
    (let ((begin nil)
          (end nil)
          cache)

      (while (not end)
        (setq cache (wisi-forward-cache))
        (cl-case (wisi-cache-nonterm cache)
          (pragma (wisi-goto-end-1 cache))
          (use_clause (wisi-goto-end-1 cache))
          (with_clause
           (when (not begin)
             (setq begin (point-at-bol)))
           (wisi-goto-end-1 cache))
          (t
           ;; start of compilation unit
           (setq end (point-at-bol))
           (unless begin
             (setq begin end)))
          ))
      (cons begin end)
    )))

(defun ada-wisi-on-context-clause ()
  "For `ada-on-context-clause'."
  (let (cache)
    (save-excursion
      ;; Don't require parse of large file just for ada-find-other-file
      (and (< (point-max) wisi-size-threshold)
           (setq cache (wisi-goto-statement-start))
           (memq (wisi-cache-nonterm cache) '(use_clause with_clause))
           ))))

(defun ada-wisi-in-case-expression ()
  "For `ada-in-case-expression'."
  (save-excursion
    ;; Used by ada-align, which does indent, which will require parse
    ;; We know we are in a paren.
    (ada-goto-open-paren 1)
    (let ((cache (wisi-get-cache (point))))
      (and cache
           (eq (wisi-cache-nonterm cache) 'case_expression)))
    ))

(defun ada-wisi-goto-subunit-name ()
  "For `ada-goto-subunit-name'."
  (wisi-validate-cache (point-max))
  (if (not (> wisi-cache-max (point)))
      (progn
        (message "parse failed; can't goto subunit name")
        nil)

    (let ((end nil)
          cache
          (name-pos nil))
      (save-excursion
        ;; move to top declaration
        (goto-char (point-min))
        (setq cache (or (wisi-get-cache (point))
                        (wisi-forward-cache)))
        (while (not end)
          (cl-case (wisi-cache-nonterm cache)
            ((pragma use_clause with_clause)
             (wisi-goto-end-1 cache)
             (setq cache (wisi-forward-cache)))
            (t
             ;; start of compilation unit
             (setq end t))
            ))
        (when (eq (wisi-cache-nonterm cache) 'subunit)
          (wisi-forward-find-class 'name (point-max)) ;; parent name
          (wisi-forward-token)
          (wisi-forward-find-class 'name (point-max)) ;; subunit name
          (setq name-pos (point)))
        )
      (when name-pos
        (goto-char name-pos))
      )))

(defun ada-wisi-goto-declaration-start ()
  "For `ada-goto-declaration-start', which see.
Also return cache at start."
  (wisi-validate-cache (point))
  (unless (> wisi-cache-max (point))
    (error "parse failed; can't goto declarative-region-start"))

  (let ((cache (wisi-get-cache (point)))
        (done nil))
    (unless cache
      (setq cache (wisi-backward-cache)))
    ;; cache is null at bob
    (while (not done)
      (if cache
          (progn
            (setq done
                  (cl-case (wisi-cache-nonterm cache)
                    ((generic_package_declaration generic_subprogram_declaration)
                     (eq (wisi-cache-token cache) 'GENERIC))

                    ((package_body package_declaration)
                     (eq (wisi-cache-token cache) 'PACKAGE))

                    ((protected_body protected_type_declaration single_protected_declaration)
                     (eq (wisi-cache-token cache) 'PROTECTED))

                    ((abstract_subprogram_declaration
                      subprogram_body
                      subprogram_declaration
                      null_procedure_declaration)
                     (memq (wisi-cache-token cache) '(NOT OVERRIDING FUNCTION PROCEDURE)))

                    (task_type_declaration
                     (eq (wisi-cache-token cache) 'TASK))

                    ))
            (unless done
              (setq cache (wisi-goto-containing cache nil))))
        (setq done t))
        )
    cache))

(defun ada-wisi-goto-declaration-end ()
  "For `ada-goto-declaration-end', which see."
  ;; first goto-declaration-start, so we get the right end, not just
  ;; the current statement end.
  (wisi-goto-end-1 (ada-wisi-goto-declaration-start)))

(defun ada-wisi-goto-declarative-region-start ()
  "For `ada-goto-declarative-region-start', which see."
  (wisi-validate-cache (point))
  (unless (> wisi-cache-max (point))
    (error "parse failed; can't goto declarative-region-start"))

  (let ((done nil)
        (first t)
        (cache
         (or
          (wisi-get-cache (point))
          ;; we use forward-cache here, to handle the case where point is after a subprogram declaration:
          ;; declare
          ;;     ...
          ;;     function ... is ... end;
          ;;     <point>
          ;;     function ... is ... end;
          (wisi-forward-cache))))
    (while (not done)
      (if (ada-wisi-declarative-region-start-p cache)
          (progn
            (wisi-forward-token)
            (setq done t))
        (cl-case (wisi-cache-class cache)
          ((block-middle block-end)
           (setq cache (wisi-prev-statement-cache cache)))

          (statement-start
           ;; 1) test/ada_mode-nominal.adb
           ;;    protected body Protected_1 is -- target 2
           ;;        <point>
           ;;    want target 2
           ;;
           ;; 2) test/ada_mode-nominal.adb
           ;;    function Function_Access_1
           ;;      (A_Param <point> : in Float)
           ;;      return
           ;;        Standard.Float
           ;;    is -- target 1
           ;;    want target 1
           ;;
           ;; 3) test/ada_mode-nominal-child.adb
           ;;    overriding <point> function Function_2c (Param : in Child_Type_1)
           ;;                                    return Float
           ;;    is -- target Function_2c
           ;;    want target

           (if first
               ;; case 1
               (setq cache (wisi-goto-containing cache t))
             ;; case 2, 3
             (cl-case (wisi-cache-nonterm cache)
               (subprogram_body
                (while (not (eq 'IS (wisi-cache-token cache)))
                  (setq cache (wisi-next-statement-cache cache))))
               (t
                (setq cache (wisi-goto-containing cache t)))
               )))
          (t
           (setq cache (wisi-goto-containing cache t)))
          ))
      (when first (setq first nil)))
    ))

(defun ada-wisi-in-paramlist-p (&optional parse-result)
  "For `ada-in-paramlist-p'."
  (wisi-validate-cache (point))
  ;; (info "(elisp)Parser State" "*syntax-ppss*")
  (let ((parse-result (or parse-result (syntax-ppss)))
         cache)
    (and (> (nth 0 parse-result) 0)
         ;; cache is nil if the parse failed
         (setq cache (wisi-get-cache (nth 1 parse-result)))
         (eq 'formal_part (wisi-cache-nonterm cache)))
    ))

(defun ada-wisi-make-subprogram-body ()
  "For `ada-make-subprogram-body'."
  (wisi-validate-cache (point))
  (when wisi-parse-failed
    (error "syntax parse failed; cannot create body"))

  (let* ((begin (point))
         (end (save-excursion (wisi-forward-find-class 'statement-end (point-max)) (point)))
         (cache (wisi-forward-find-class 'name end))
         (name (buffer-substring-no-properties
                (point)
                (+ (point) (wisi-cache-last cache)))))
    (goto-char end)
    (newline)
    (insert " is begin\nnull;\nend ");; legal syntax; parse does not fail
    (insert name)
    (forward-char 1)

    ;; newline after body to separate from next body
    (newline-and-indent)
    (indent-region begin (point))
    (forward-line -2)
    (back-to-indentation); before 'null;'
    ))

(defun ada-wisi-scan-paramlist (begin end)
  "For `ada-scan-paramlist'."
  (wisi-validate-cache end)
  (when (< wisi-cache-max end)
    (error "parse failed; can't scan paramlist"))

  (goto-char begin)
  (let (token
        text
        identifiers
        (aliased-p nil)
        (in-p nil)
        (out-p nil)
        (not-null-p nil)
        (access-p nil)
        (constant-p nil)
        (protected-p nil)
        (type nil)
        type-begin
        type-end
        (default nil)
        (default-begin nil)
        param
        paramlist
        (done nil))
    (while (not done)
      (let ((token-text (wisi-forward-token)))
        (setq token (nth 0 token-text))
        (setq text  (wisi-token-text token-text)))
      (cond
       ((equal token 'COMMA) nil);; multiple identifiers

       ((equal token 'COLON)
        ;; identifiers done. find type-begin; there may be no mode
        (skip-syntax-forward " ")
        (setq type-begin (point))
        (save-excursion
          (while (member (car (wisi-forward-token)) '(ALIASED IN OUT NOT NULL ACCESS CONSTANT PROTECTED))
            (skip-syntax-forward " ")
            (setq type-begin (point)))))

       ((equal token 'ALIASED) (setq aliased-p t))
       ((equal token 'IN) (setq in-p t))
       ((equal token 'OUT) (setq out-p t))
       ((and (not type-end)
             (member token '(NOT NULL)))
        ;; "not", "null" could be part of the default expression
        (setq not-null-p t))
       ((equal token 'ACCESS) (setq access-p t))
       ((equal token 'CONSTANT) (setq constant-p t))
       ((equal token 'PROTECTED) (setq protected-p t))

       ((equal token 'COLON_EQUAL)
        (setq type-end (save-excursion (backward-char 2) (skip-syntax-backward " ") (point)))
        (skip-syntax-forward " ")
        (setq default-begin (point))
        (wisi-forward-find-token 'SEMICOLON end t))

       ((equal token 'LEFT_PAREN)
        ;; anonymous access procedure type
        (goto-char (scan-sexps (1- (point)) 1)))

       ((member token '(SEMICOLON RIGHT_PAREN))
        (when (not type-end)
          (setq type-end (save-excursion (backward-char 1) (skip-syntax-backward " ") (point))))

        (setq type (buffer-substring-no-properties type-begin type-end))

        (when default-begin
          (setq default (buffer-substring-no-properties default-begin (1- (point)))))

        (when (equal token 'RIGHT_PAREN)
          (setq done t))

        (setq param (list (reverse identifiers)
                          aliased-p in-p out-p not-null-p access-p constant-p protected-p
                          type default))
        (cl-pushnew param paramlist :test #'equal)
        (setq identifiers nil
              aliased-p nil
              in-p nil
              out-p nil
              not-null-p nil
              access-p nil
              constant-p nil
              protected-p nil
              type nil
              type-begin nil
              type-end nil
              default nil
              default-begin nil))

       (t
        (when (not type-begin)
          (cl-pushnew text identifiers :test #'equal)))
       ))
    paramlist))

(defun ada-wisi-which-function-1 (keyword add-body)
  "Used in `ada-wisi-which-function'."
  (let* ((cache (wisi-forward-find-class 'name (point-max)))
         (result (wisi-cache-text cache)))

    ;; See comment at ada-mode.el on why we don't overwrite ff-function-name.
    (when (not ff-function-name)
      (setq ff-function-name
            (concat
             keyword
             (when add-body "\\s-+body")
             "\\s-+"
             result
             ada-symbol-end)))
    result))

(defun ada-wisi-which-function ()
  "For `ada-which-function'."
  (wisi-validate-cache (point))
  (save-excursion
    (let ((result nil)
          (cache (condition-case nil (ada-wisi-goto-declaration-start) (error nil))))
      (if (null cache)
          ;; bob or failed parse
          (setq result "")

        (when (memq (wisi-cache-nonterm cache)
                    '(generic_package_declaration generic_subprogram_declaration))
          ;; name is after next statement keyword
          (wisi-next-statement-cache cache)
          (setq cache (wisi-get-cache (point))))

        ;; add or delete 'body' as needed
        (cl-ecase (wisi-cache-nonterm cache)
          (package_body
           (setq result (ada-wisi-which-function-1 "package" nil)))

          ((package_declaration
            generic_package_declaration) ;; after 'generic'
           (setq result (ada-wisi-which-function-1 "package" t)))

          (protected_body
           (setq result (ada-wisi-which-function-1 "protected" nil)))

          ((protected_type_declaration single_protected_declaration)
           (setq result (ada-wisi-which-function-1 "protected" t)))

          ((abstract_subprogram_declaration
            subprogram_declaration
            generic_subprogram_declaration ;; after 'generic'
            null_procedure_declaration)
           (setq result (ada-wisi-which-function-1
                         (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
                         nil))) ;; no 'body' keyword in subprogram bodies

          (subprogram_body
           (setq result (ada-wisi-which-function-1
                         (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
                         nil)))

          (task_type_declaration
           (setq result (ada-wisi-which-function-1 "task" t)))

          ))
      result)))

;;;; debugging
(defun ada-wisi-debug-keys ()
  "Add debug key definitions to `ada-mode-map'."
  (interactive)
  (define-key ada-mode-map "\M-e" 'wisi-show-parse-error)
  (define-key ada-mode-map "\M-h" 'wisi-show-containing-or-previous-cache)
  (define-key ada-mode-map "\M-i" 'wisi-goto-statement-end)
  (define-key ada-mode-map "\M-j" 'wisi-show-cache)
  (define-key ada-mode-map "\M-k" 'wisi-show-token)
  )

(defun ada-wisi-number-p (token-text)
  "Return t if TOKEN-TEXT plus text after point matches the
syntax for a real literal; otherwise nil. point is after
TOKEN-TEXT; move point to just past token."
  ;; test in test/wisi/ada-number-literal.input
  ;;
  ;; starts with a simple integer
  (let ((end (point)))
    ;; this first test must be very fast; it is executed for every token
    (when (and (memq (aref token-text 0) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
               (string-match "^[0-9_]+$" token-text))
      (cond
       ((= (char-after) ?#)
        ;; based number
        (forward-char 1)
        (if (not (looking-at "[0-9a-fA-F_]+"))
            (progn (goto-char end) nil)

          (goto-char (match-end 0))
          (cond
           ((= (char-after) ?#)
            ;; based integer
            (forward-char 1)
            t)

           ((= (char-after) ?.)
            ;; based real?
            (forward-char 1)
            (if (not (looking-at "[0-9a-fA-F]+"))
                (progn (goto-char end) nil)

              (goto-char (match-end 0))

              (if (not (= (char-after) ?#))
                  (progn (goto-char end) nil)

                (forward-char 1)
                (setq end (point))

                (if (not (memq (char-after) '(?e ?E)))
                    ;; based real, no exponent
                    t

                  ;; exponent?
                  (forward-char 1)
                  (if (not (looking-at "[+-]?[0-9]+"))
                      (progn (goto-char end) t)

                    (goto-char (match-end 0))
                    t
                )))))

           (t
            ;; missing trailing #
            (goto-char end) nil)
           )))

       ((= (char-after) ?.)
        ;; decimal real number?
        (forward-char 1)
        (if (not (looking-at "[0-9_]+"))
            ;; decimal integer
            (progn (goto-char end) t)

          (setq end (goto-char (match-end 0)))

          (if (not (memq (char-after) '(?e ?E)))
              ;; decimal real, no exponent
              t

            ;; exponent?
            (forward-char 1)
            (if (not (looking-at "[+-]?[0-9]+"))
                (progn (goto-char end) t)

              (goto-char (match-end 0))
              t
              ))))

       (t
        ;; just an integer
        t)
       ))
    ))

(defun ada-wisi-setup ()
  "Set up a buffer for parsing Ada files with wisi."
  (wisi-setup '(ada-wisi-comment
                ada-wisi-before-cache
                ada-wisi-after-cache)
              'ada-wisi-post-parse-fail
              ada-wisi-class-list
              ada-grammar-wy--keyword-table
              ada-grammar-wy--token-table
              ada-grammar-wy--parse-table)

  ;; Handle escaped quotes in strings
  (setq wisi-string-quote-escape-doubled t)

  (set (make-local-variable 'comment-indent-function) 'wisi-comment-indent)
  )

(add-hook 'ada-mode-hook 'ada-wisi-setup)

(setq ada-fix-context-clause 'ada-wisi-context-clause)
(setq ada-goto-declaration-end 'ada-wisi-goto-declaration-end)
(setq ada-goto-declaration-start 'ada-wisi-goto-declaration-start)
(setq ada-goto-declarative-region-start 'ada-wisi-goto-declarative-region-start)
(setq ada-goto-end 'wisi-goto-statement-end)
(setq ada-goto-subunit-name 'ada-wisi-goto-subunit-name)
(setq ada-in-paramlist-p 'ada-wisi-in-paramlist-p)
(setq ada-indent-statement 'wisi-indent-statement)
(setq ada-make-subprogram-body 'ada-wisi-make-subprogram-body)
(setq ada-next-statement-keyword 'wisi-forward-statement-keyword)
(setq ada-on-context-clause 'ada-wisi-on-context-clause)
(setq ada-in-case-expression 'ada-wisi-in-case-expression)
(setq ada-prev-statement-keyword 'wisi-backward-statement-keyword)
(setq ada-reset-parser 'wisi-invalidate-cache)
(setq ada-scan-paramlist 'ada-wisi-scan-paramlist)
(setq ada-show-parse-error 'wisi-show-parse-error)
(setq ada-which-function 'ada-wisi-which-function)

(provide 'ada-wisi)
(provide 'ada-indent-engine)

;; end of file