code.delx.au - gnu-emacs-elpa/blob - packages/ada-mode/ada-wisi.el

   1 ;;; An indentation engine for Ada mode, using the wisi generalized LALR parser
   2 ;;
   3 ;; [1] ISO/IEC 8652:2012(E); Ada 2012 reference manual
   4 ;;
   5 ;; Copyright (C) 2012 - 2014  Free Software Foundation, Inc.
   6 ;;
   7 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
   8 ;;
   9 ;; This file is part of GNU Emacs.
  10 ;;
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15 ;;
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23 ;;
  24 ;;; History:
  25 ;;
  26 ;; implementation started Jan 2013
  27 ;;
  28 ;;;;
  29
  30 (require 'ada-fix-error)
  31 (require 'ada-grammar-wy)
  32 (require 'ada-indent-user-options)
  33 (require 'cl-lib)
  34 (require 'wisi)
  35
  36 (defconst ada-wisi-class-list
  37   '(
  38     block-end
  39     block-middle ;; not start of statement
  40     block-start ;; start of block is start of statement
  41     close-paren
  42     list-break
  43     name
  44     name-paren ;; anything that looks like a procedure call, since the grammar can't distinguish most of them
  45     open-paren
  46     return
  47     return-1
  48     return-2
  49     statement-end
  50     statement-other
  51     statement-start
  52     type
  53     ))
  54
  55 ;;;; indentation
  56
  57 (defun ada-wisi-current-indentation ()
  58   "Return indentation of current line, incremented by 1 if starts with open-paren."
  59   (if (not (ada-in-paren-p))
  60       (current-indentation)
  61
  62     (save-excursion
  63       (back-to-indentation)
  64       (let ((cache (wisi-get-cache (point))))
  65         (if (and cache
  66                  (eq 'open-paren (wisi-cache-class cache)))
  67             (1+ (current-column))
  68           (current-column))
  69         ))))
  70
  71 (defun ada-wisi-indent-cache (offset cache)
  72   "Return indentation of OFFSET plus indentation of line containing point. Point must be at CACHE."
  73   (let ((indent (current-indentation)))
  74     (cond
  75      ;; special cases
  76      ;;
  77      ((eq 'LEFT_PAREN (wisi-cache-token cache))
  78       ;; test/ada_mode-long_paren.adb
  79       ;; (RT                            => RT,
  80       ;;  Monitor                       => True,
  81       ;;  RX_Enable                     =>
  82       ;;    (RX_Torque_Subaddress |
  83       ;;   indenting '(RX_'
  84       ;;
  85       ;; test/ada_mode-parens.adb
  86       ;; return Float (
  87       ;;               Integer'Value
  88       ;;                 (Local_6));
  89       ;;   indenting '(local_6)'; 'offset' = ada-indent - 1
  90       (+ (current-column) 1 offset))
  91
  92      ((save-excursion
  93         (let ((containing (wisi-goto-containing-paren cache)))
  94           (and containing
  95                ;; test/ada_mode-conditional_expressions.adb
  96                ;; K2 : Integer := (if J > 42
  97                ;;                  then -1
  98                ;;   indenting 'then'; offset = 0
  99                ;;
 100                ;; L1 : Integer := (case J is
 101                ;;                     when 42 => -1,
 102                ;;
 103                ;; test/indent.ads
 104                ;; C_S_Controls : constant
 105                ;;   CSCL_Type :=
 106                ;;     CSCL_Type'
 107                ;;       (
 108                ;;        1 =>  --  Used to be aligned on "CSCL_Type'"
 109                ;;              --  aligned with previous comment.
 110                ;;          IO_CPU_Control_State_S_Pkg.CPU2_Fault_Status_Type'
 111                ;;            (Unused2  => 10,  -- Used to be aligned on "1 =>"
 112                ;;  indenting '(Unused2'
 113                (+ (current-column) offset)))))
 114
 115      ;; all other structures
 116      (t
 117       ;; current cache may be preceded by something on same
 118       ;; line. Handle common cases nicely.
 119       (while (and cache
 120                   (or
 121                    (not (= (current-column) indent))
 122                    (eq 'EQUAL_GREATER (wisi-cache-token cache))))
 123         (when (and
 124                (eq 'WHEN (wisi-cache-token cache))
 125                (not (eq 'exit_statement (wisi-cache-nonterm cache))))
 126           (setq offset (+ offset ada-indent-when)))
 127         (setq cache (wisi-goto-containing cache))
 128         (setq indent (current-indentation)))
 129
 130       (cond
 131        ((null cache)
 132         ;; test/ada_mode-opentoken.ads
 133         ;; private package GDS.Commands.Add_Statement is
 134         ;;    type Instance is new Nonterminal.Instance with null record;
 135         offset)
 136
 137        ((eq 'label_opt (wisi-cache-token cache))
 138         (+ indent (- ada-indent-label) offset))
 139
 140        (t
 141         ;; test/ada_mode-generic_instantiation.ads
 142         ;; function Function_1 is new Instance.Generic_Function
 143         ;;   (Param_Type  => Integer,
 144         ;;
 145         ;; test/ada_mode-nested_packages.adb
 146         ;; function Create (Model   : in Integer;
 147         ;;                  Context : in String) return String is
 148         ;;    ...
 149         ;;    Cache : array (1 .. 10) of Boolean := (True, False, others => False);
 150         (+ indent offset))
 151        ))
 152      )))
 153
 154 (defun ada-wisi-indent-containing (offset cache &optional before)
 155   "Return indentation of OFFSET plus indentation of token containing CACHE.
 156 BEFORE should be t when called from ada-wisi-before-cache, nil otherwise."
 157   (save-excursion
 158     (cond
 159      ((markerp (wisi-cache-containing cache))
 160       (ada-wisi-indent-cache offset (wisi-goto-containing cache)))
 161
 162      (t
 163       (cond
 164        ((ada-in-paren-p)
 165         (ada-goto-open-paren 1)
 166         (+ (current-column) offset))
 167
 168        (t
 169         ;; at outermost containing statement. If called from
 170         ;; ada-wisi-before-cache, we want to ignore OFFSET (indenting
 171         ;; 'package' in a package spec). If called from
 172         ;; ada-wisi-after-cache, we want to include offset (indenting
 173         ;; first declaration in the package).
 174         (if before 0 offset))
 175        ))
 176       )))
 177
 178 (defun ada-wisi-indent-list-break (cache prev-token)
 179   "Return indentation for a token contained by CACHE, which must be a list-break.
 180 point must be on CACHE. PREV-TOKEN is the token before the one being indented."
 181   (let ((break-point (point))
 182         (containing (wisi-goto-containing cache)))
 183     (cl-ecase (wisi-cache-token containing)
 184       (LEFT_PAREN
 185        (if (equal break-point (cl-caddr prev-token))
 186            ;; we are indenting the first token after the list-break; not hanging.
 187            ;;
 188            ;; test/parent.adb
 189            ;; Append_To (Formals,
 190            ;;            Make_Parameter_Specification (Loc,
 191            ;; indenting 'Make_...'
 192            ;;
 193            ;; test/ada_mode-generic_instantiation.ads
 194            ;; function Function_1 is new Instance.Generic_Function
 195            ;;   (Param_Type  => Integer,
 196            ;;    Result_Type => Boolean,
 197            ;;    Threshold   => 2);
 198            ;; indenting 'Result_Type'
 199            (+ (current-column) 1)
 200          ;; else hanging
 201          ;;
 202          ;; test/ada_mode-parens.adb
 203          ;; A :=
 204          ;;   (1 |
 205          ;;      2 => (1, 1, 1),
 206          ;;    3 |
 207          ;;      4 => (2, 2, 2));
 208          ;; indenting '4 =>'
 209          (+ (current-column) 1 ada-indent-broken)))
 210
 211       (IS
 212        ;; test/ada_mode-conditional_expressions.adb
 213        ;; L1 : Integer := (case J is
 214        ;;                     when 42 => -1,
 215        ;;                     -- comment aligned with 'when'
 216        ;; indenting '-- comment'
 217        (wisi-indent-paren (+ 1 ada-indent-when)))
 218
 219       (WITH
 220        (cl-ecase (wisi-cache-nonterm containing)
 221          (aggregate
 222           ;; test/ada_mode-nominal-child.ads
 223           ;; (Default_Parent with
 224           ;;  Child_Element_1 => 10,
 225           ;;  Child_Element_2 => 12.0,
 226           ;; indenting 'Child_Element_2'
 227           (wisi-indent-paren 1))
 228
 229          (aspect_specification_opt
 230           ;; test/aspects.ads:
 231           ;; type Vector is tagged private
 232           ;;   with
 233           ;;     Constant_Indexing => Constant_Reference,
 234           ;;     Variable_Indexing => Reference,
 235           ;; indenting 'Variable_Indexing'
 236           (+ (current-indentation) ada-indent-broken))
 237          ))
 238       )
 239     ))
 240
 241 (defun ada-wisi-before-cache ()
 242   "Point is at indentation, before a cached token. Return new indentation for point."
 243   (let ((pos-0 (point))
 244         (cache (wisi-get-cache (point)))
 245         (prev-token (save-excursion (wisi-backward-token)))
 246         )
 247     (when cache
 248       (cl-ecase (wisi-cache-class cache)
 249         (block-start
 250          (cl-case (wisi-cache-token cache)
 251            (IS ;; subprogram body
 252             (ada-wisi-indent-containing 0 cache t))
 253
 254            (RECORD
 255             ;; test/ada_mode-nominal.ads; ada-indent-record-rel-type = 3
 256             ;; type Private_Type_2 is abstract tagged limited
 257             ;;    record
 258             ;; indenting 'record'
 259             ;;
 260             ;; type Limited_Derived_Type_1d is
 261             ;;    abstract limited new Private_Type_1 with
 262             ;; record
 263             ;; indenting 'record'
 264             ;;
 265             ;; for Record_Type_1 use
 266             ;;   record
 267             ;;   indenting 'record'
 268             (let ((containing (wisi-goto-containing cache)))
 269               (while (not (memq (wisi-cache-token containing) '(FOR TYPE)))
 270                 (setq containing (wisi-goto-containing containing)))
 271               (+ (current-column) ada-indent-record-rel-type)))
 272
 273            (t ;; other
 274             (ada-wisi-indent-containing ada-indent cache t))))
 275
 276         (block-end
 277          (cl-case (wisi-cache-nonterm cache)
 278            (record_definition
 279             (save-excursion
 280               (wisi-goto-containing cache);; now on 'record'
 281               (current-indentation)))
 282
 283            (t
 284             (ada-wisi-indent-containing 0 cache t))
 285            ))
 286
 287         (block-middle
 288          (cl-case (wisi-cache-token cache)
 289            (WHEN
 290             (ada-wisi-indent-containing ada-indent-when cache t))
 291
 292            (t
 293             (ada-wisi-indent-containing 0 cache t))
 294            ))
 295
 296         (close-paren (wisi-indent-paren 0))
 297
 298         (name
 299          (ada-wisi-indent-containing ada-indent-broken cache t))
 300
 301         (name-paren
 302          (let ((containing (wisi-goto-containing cache)))
 303            (cl-case (wisi-cache-class containing)
 304              (open-paren
 305               ;; test/ada_mode-slices.adb
 306               ;; Put_Line(Day'Image(D1) & " - " & Day'Image(D2) & " = " &
 307               ;;            Integer'Image(N));
 308               ;;
 309               ;; test/ada_mode-parens.adb
 310               ;; return Float (
 311               ;;               Integer'Value
 312               ;; indenting 'Integer'
 313               ;;
 314               ;; We distinguish the two cases by going to the first token,
 315               ;; and comparing point to pos-0.
 316               (let ((paren-column (current-column)))
 317                 (wisi-forward-token t); "("
 318                 (forward-comment (point-max))
 319                 (if (= (point) pos-0)
 320                     ;; 2)
 321                     (1+ paren-column)
 322                   ;; 1)
 323                   (+ paren-column 1 ada-indent-broken))))
 324
 325              (list-break
 326               (ada-wisi-indent-list-break containing prev-token))
 327
 328              (t
 329               ;; test/ada_mode-generic_instantiation.ads
 330               ;;   procedure Procedure_6 is new
 331               ;;     Instance.Generic_Procedure (Integer, Function_1);
 332               ;; indenting 'Instance'; containing is 'new'
 333               (ada-wisi-indent-cache ada-indent-broken containing))
 334              )))
 335
 336         (open-paren
 337          (let ((containing (wisi-goto-containing cache)))
 338            (cl-case (wisi-cache-token containing)
 339              (COMMA
 340               ;; test/ada_mode-parens.adb
 341               ;; A : Matrix_Type :=
 342               ;;   ((1, 2, 3),
 343               ;;    (4, 5, 6),
 344               ;; indenting (4
 345               (ada-wisi-indent-containing 0 containing))
 346
 347              (EQUAL_GREATER
 348               (setq containing (wisi-goto-containing containing))
 349               (cl-ecase (wisi-cache-token containing)
 350                 (COMMA
 351                  ;; test/ada_mode-long_paren.adb
 352                  ;; (RT                            => RT,
 353                  ;;  Monitor                       => True,
 354                  ;;  RX_Enable                     =>
 355                  ;;    (RX_Torque_Subaddress |
 356                  ;; indenting (RX_Torque
 357                  (ada-wisi-indent-containing ada-indent-broken containing t))
 358                 (LEFT_PAREN
 359                  ;; test/ada_mode-parens.adb
 360                  ;; (1 =>
 361                  ;;    (1 => 12,
 362                  ;; indenting '(1 => 12'; containing is '=>'
 363                  (ada-wisi-indent-cache (1- ada-indent) containing))
 364                 (WHEN
 365                  ;; test/ada_mode-conditional_expressions.adb
 366                  ;;  when 1 =>
 367                  ;;    (if J > 42
 368                  ;; indenting '(if'; containing is '=>'
 369                  (+ (current-column) -1 ada-indent))
 370                 ))
 371
 372              ((FUNCTION PROCEDURE)
 373               ;; test/ada_mode-nominal.adb
 374               ;; function Function_Access_11
 375               ;;   (A_Param : in Float)
 376               ;;   --  EMACSCMD:(test-face "function" font-lock-keyword-face)
 377               ;;   return access function
 378               ;;     (A_Param : in Float)
 379               ;;     return
 380               ;;     Standard.Float -- Ada mode 4.01, GPS do this differently
 381               ;; indenting second '(A_Param)
 382               (+ (current-indentation) -1 ada-indent))
 383
 384              (LEFT_PAREN
 385               ;; test/ada_mode-parens.adb
 386               ;; or else ((B.all
 387               ;;             and then C)
 388               ;;            or else
 389               ;;            (D
 390               ;; indenting (D
 391               (+ (current-column) 1 ada-indent-broken))
 392
 393              (WHEN
 394               ;; test/ada_mode-nominal.adb
 395               ;;
 396               ;; when Local_1 = 0 and not
 397               ;;   (Local_2 = 1)
 398               ;; indenting (Local_2
 399               ;;
 400               ;; entry E3
 401               ;;   (X : Integer) when Local_1 = 0 and not
 402               ;;     (Local_2 = 1)
 403               (+ (ada-wisi-current-indentation) ada-indent-broken))
 404
 405              (name
 406               ;; test/indent.ads
 407               ;; CSCL_Type'
 408               ;;   (
 409               ;; identing (
 410               ;;
 411               ;; test/ada_mode-parens.adb
 412               ;; Check
 413               ;;   ("foo bar",
 414               ;;    A
 415               ;;      (1),
 416               ;;    A(2));
 417               ;; indenting (1)
 418               ;;
 419               ;; test/ada_mode-parens.adb
 420               ;; Local_11 : Local_11_Type := Local_11_Type'
 421               ;;   (A => Integer
 422               ;;      (1.0),
 423               ;;    B => Integer
 424               ;;      (2.0));
 425               (+ (ada-wisi-current-indentation) ada-indent-broken))
 426
 427              (t
 428               (cond
 429                 ((memq (wisi-cache-class containing) '(block-start statement-start))
 430                  ;; test/ada_mode-nominal.adb
 431                  ;; entry E2
 432                  ;;   (X : Integer)
 433                  ;; indenting (X
 434                  (ada-wisi-indent-cache ada-indent-broken containing))
 435
 436                 (t
 437                  ;; Open paren in an expression.
 438                  ;;
 439                  ;; test/ada_mode-conditional_expressions.adb
 440                  ;; L0 : Integer :=
 441                  ;;   (case J is when 42 => -1, when Integer'First .. 41 => 0, when others => 1);
 442                  ;; indenting (case
 443                  (ada-wisi-indent-containing ada-indent-broken containing t))
 444                 ))
 445              )))
 446
 447         (return-1;; parameter list
 448          (let ((return-pos (point)))
 449            (wisi-goto-containing cache nil) ;; matching 'function'
 450            (cond
 451             ((<= ada-indent-return 0)
 452              ;; indent relative to "("
 453              (wisi-forward-find-class 'open-paren return-pos)
 454              (+ (current-column) (- ada-indent-return)))
 455
 456             (t
 457              (+ (current-column) ada-indent-return))
 458             )))
 459
 460         (return-2;; no parameter list
 461          (wisi-goto-containing cache nil) ;; matching 'function'
 462          (+ (current-column) ada-indent-broken))
 463
 464         (statement-end
 465          (ada-wisi-indent-containing ada-indent-broken cache t))
 466
 467         (statement-other
 468          (let ((containing (wisi-goto-containing cache nil)))
 469            (cl-case (wisi-cache-token cache)
 470              (EQUAL_GREATER
 471               (+ (current-column) ada-indent-broken))
 472
 473              (ELSIF
 474               ;; test/g-comlin.adb
 475               ;;   elsif Current_Argument < CL.Argument_Count then
 476               (ada-wisi-indent-cache 0 containing))
 477
 478              (RENAMES
 479               (cl-ecase (wisi-cache-nonterm containing)
 480                 ((generic_renaming_declaration subprogram_renaming_declaration)
 481                  (wisi-forward-find-token '(FUNCTION PROCEDURE) pos-0)
 482                  (let ((pos-subprogram (point))
 483                        (has-params
 484                         ;; this is wrong for one return access
 485                         ;; function case: overriding function Foo
 486                         ;; return access Bar (...) renames ...;
 487                         (wisi-forward-find-token 'LEFT_PAREN pos-0 t)))
 488                    (if has-params
 489                        (if (<= ada-indent-renames 0)
 490                            ;; indent relative to paren
 491                            (+ (current-column) (- ada-indent-renames))
 492                          ;; else relative to line containing keyword
 493                          (goto-char pos-subprogram)
 494                          (+ (current-indentation) ada-indent-renames))
 495
 496                      ;; no params
 497                      (goto-char pos-subprogram)
 498                      (+ (current-indentation) ada-indent-broken))
 499                    ))
 500
 501                 (object_renaming_declaration
 502                  (+ (current-indentation) ada-indent-broken))
 503                 ))
 504
 505              (t
 506               (while (not (wisi-cache-nonterm containing))
 507                 (setq containing (wisi-goto-containing containing)))
 508
 509               (cl-ecase (wisi-cache-nonterm containing)
 510                 (aggregate
 511                  ;; indenting 'with'
 512                  (+ (current-column) 1))
 513
 514                 (association_opt
 515                  ;; test/indent.ads
 516                  ;; 1 =>  --  Used to be aligned on "CSCL_Type'"
 517                  ;;       --  aligned with previous comment.
 518                  ;;   IO_CPU_Control_State_S_Pkg.CPU2_Fault_Status_Type'
 519                  (ada-wisi-indent-cache ada-indent-broken containing))
 520
 521                 (asynchronous_select
 522                  ;; indenting 'abort'
 523                  (+ (current-column) ada-indent-broken))
 524
 525                 (component_declaration
 526                  ;; test/ada_mode-nominal.ads record_type_3
 527                  (+ (current-column) ada-indent-broken))
 528
 529                 (entry_body
 530                  ;; indenting 'when'
 531                  (+ (current-column) ada-indent-broken))
 532
 533                 (formal_package_declaration
 534                  ;; test/ada_mode-generic_package.ads
 535                  ;; with package A_Package_7 is
 536                  ;;   new Ada.Text_IO.Integer_IO (Num => Formal_Signed_Integer_Type);
 537                  ;; indenting 'new'
 538                  (+ (current-column) ada-indent-broken))
 539
 540                 (full_type_declaration
 541                  ;; test/ada_mode-nominal.ads
 542                  ;; type Unconstrained_Array_Type_3 is array (Integer range <>, Standard.Character range <>)
 543                  ;;   of Object_Access_Type_1;
 544                  ;; indenting 'of'
 545                  ;;
 546                  ;; type Object_Access_Type_7
 547                  ;;   is access all Integer;
 548                  ;; indenting 'is'
 549                  ;;
 550                  ;; type Limited_Derived_Type_1 is abstract limited new Private_Type_1 with
 551                  ;; record
 552                  ;; indenting 'record'
 553                  ;;
 554                  ;; type Limited_Derived_Type_3 is abstract limited new Private_Type_1
 555                  ;;   with null record;
 556                  ;; indenting 'with'
 557                  ;;
 558                  ;; type Limited_Derived_Type_2a is abstract limited new Private_Type_1
 559                  ;; with record
 560                  ;; indenting 'with record'
 561                  (while (not (eq 'TYPE (wisi-cache-token containing)))
 562                    (setq containing (wisi-goto-containing containing)))
 563
 564                  (cond
 565                   ((eq (wisi-cache-token cache) 'RECORD)
 566                    (+ (current-column) ada-indent-record-rel-type))
 567
 568                   ((eq (wisi-cache-token cache) 'WITH)
 569                    (let ((type-col (current-column)))
 570                      (wisi-goto-end-1 cache)
 571                      (if (eq 'WITH (wisi-cache-token (wisi-backward-cache)))
 572                          ;; 'with null record;' or 'with private;'
 573                          (+ type-col ada-indent-broken)
 574                        (+ type-col ada-indent-record-rel-type))))
 575
 576                   (t
 577                    (+ (current-column) ada-indent-broken))
 578                   ))
 579
 580                 (generic_instantiation
 581                  ;; test/ada_mode-generic_instantiation.ads
 582                  ;; procedure Procedure_7 is
 583                  ;;   new Instance.Generic_Procedure (Integer, Function_1);
 584                  ;; indenting 'new'
 585                  (+ (current-column) ada-indent-broken))
 586
 587                 (generic_renaming_declaration
 588                  ;; indenting keyword following 'generic'
 589                  (current-column))
 590
 591                 (object_declaration
 592                  (cl-ecase (wisi-cache-token containing)
 593                    (COLON
 594                     ;; test/ada_mode-nominal.ads
 595                     ;; Anon_Array_3 : array (1 .. 10)
 596                     ;;   of Integer;
 597                     ;; indenting 'of'
 598                     (+ (current-indentation) ada-indent-broken))
 599
 600                    (COLON_EQUAL
 601                     ;; test/indent.ads
 602                     ;; C_S_Controls : constant
 603                     ;;   CSCL_Type :=
 604                     ;;     CSCL_Type'
 605                     ;; indenting 'CSCL_Type'
 606                     (+ (current-indentation) ada-indent-broken))
 607
 608                    (identifier_list
 609                     ;; test/ada_mode-nominal.adb
 610                     ;; Local_2 : constant Float
 611                     ;;   := Local_1;
 612                     (+ (current-indentation) ada-indent-broken))
 613                    ))
 614
 615                 (private_type_declaration
 616                  ;; test/aspects.ads
 617                  ;; type Vector is tagged private
 618                  ;; with
 619                  ;; indenting 'with'
 620                  (+ (current-indentation) ada-indent-broken))
 621
 622                 (qualified_expression
 623                  ;; test/ada_mode-nominal-child.ads
 624                  ;; Child_Obj_5 : constant Child_Type_1 :=
 625                  ;;   (Parent_Type_1'
 626                  ;;     (Parent_Element_1 => 1,
 627                  (ada-wisi-indent-cache ada-indent-broken containing))
 628
 629                 (statement
 630                  (cl-case (wisi-cache-token containing)
 631                    (label_opt
 632                     (- (current-column) ada-indent-label))
 633
 634                    (t
 635                     ;; test/ada_mode-nominal.adb
 636                     ;; select
 637                     ;;    delay 1.0;
 638                     ;; then
 639                     ;;    -- ...
 640                     ;;   abort
 641                     (ada-wisi-indent-cache ada-indent-broken cache))
 642                    ))
 643
 644                 ((subprogram_body subprogram_declaration subprogram_specification null_procedure_declaration)
 645                  (cl-ecase (wisi-cache-token cache)
 646                    (OVERRIDING
 647                     ;; indenting 'overriding' following 'not'
 648                     (current-column))
 649
 650                    ((PROCEDURE FUNCTION)
 651                     ;; indenting 'procedure' or 'function following 'overriding'
 652                     (current-column))
 653                    ))
 654
 655                 (subtype_declaration
 656                  ;; test/adacore_9717_001.ads A_Long_Name
 657                  (+ (current-column) ada-indent-broken))
 658
 659                 ))))) ;; end statement-other
 660
 661         (statement-start
 662          (cond
 663           ((eq 'label_opt (wisi-cache-token cache))
 664            (ada-wisi-indent-containing (+ ada-indent-label ada-indent) cache t))
 665
 666           (t
 667            (let ((containing-cache (wisi-get-containing-cache cache)))
 668              (if (not containing-cache)
 669                  ;; at bob
 670                  0
 671                ;; not at bob
 672                (cl-case (wisi-cache-class containing-cache)
 673                  ((block-start block-middle)
 674                   (wisi-goto-containing cache)
 675                   (cl-case (wisi-cache-nonterm containing-cache)
 676                     (record_definition
 677                      (+ (current-indentation) ada-indent))
 678
 679                     (t
 680                      (ada-wisi-indent-cache ada-indent containing-cache))
 681                     ))
 682
 683                  (list-break
 684                   (ada-wisi-indent-list-break cache prev-token))
 685
 686                  (statement-other
 687                   (cl-case (wisi-cache-token containing-cache)
 688                     (LEFT_PAREN
 689                      ;; test/ada_mode-parens.adb
 690                      ;; return Float (
 691                      ;;               Integer'Value
 692                      ;;   indenting 'Integer'
 693                      (wisi-indent-paren 1))
 694
 695                     (EQUAL_GREATER
 696                      ;; test/ada_mode-nested_packages.adb
 697                      ;; exception
 698                      ;;    when Io.Name_Error =>
 699                      ;;       null;
 700                      (ada-wisi-indent-containing ada-indent containing-cache t))
 701
 702                     (t
 703                      ;; test/ada_mode-generic_instantiation.ads
 704                      ;; procedure Procedure_6 is new
 705                      ;;   Instance.Generic_Procedure (Integer, Function_1);
 706                      ;;   indenting 'Instance'
 707                      (ada-wisi-indent-containing ada-indent-broken cache t))
 708                     ))
 709                  ))))
 710              ))
 711
 712         (type
 713          (ada-wisi-indent-containing ada-indent-broken cache t))
 714         ))
 715     ))
 716
 717 (defun ada-wisi-after-cache ()
 718   "Point is at indentation, not before a cached token. Find previous
 719 cached token, return new indentation for point."
 720   (let ((start (point))
 721         (prev-token (save-excursion (wisi-backward-token)))
 722         (cache (wisi-backward-cache)))
 723
 724     (cond
 725      ((not cache) ;; bob
 726         0)
 727
 728      (t
 729       (while (memq (wisi-cache-class cache) '(name name-paren type))
 730         ;; not useful for indenting
 731         (setq cache (wisi-backward-cache)))
 732
 733       (cl-ecase (wisi-cache-class cache)
 734         (block-end
 735          ;; indenting block/subprogram name after 'end'
 736          (wisi-indent-current ada-indent-broken))
 737
 738         (block-middle
 739          (cl-case (wisi-cache-token cache)
 740            (IS
 741             (cl-case (wisi-cache-nonterm cache)
 742               (case_statement
 743                ;; between 'case .. is' and first 'when'; most likely a comment
 744                (ada-wisi-indent-containing 0 cache t))
 745
 746               (t
 747                (+ (ada-wisi-indent-containing ada-indent cache t)))
 748               ))
 749
 750            ((THEN ELSE)
 751             (let ((indent
 752                    (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
 753                      ((statement if_statement elsif_statement_item) ada-indent)
 754                      ((if_expression elsif_expression_item) ada-indent-broken))))
 755               (ada-wisi-indent-containing indent cache t)))
 756
 757            (WHEN
 758             ;; between 'when' and '=>'
 759             (+ (current-column) ada-indent-broken))
 760
 761            (t
 762             ;; block-middle keyword may not be on separate line:
 763             ;;       function Create (Model   : in Integer;
 764             ;;                        Context : in String) return String is
 765             (ada-wisi-indent-containing ada-indent cache nil))
 766            ))
 767
 768         (block-start
 769          (cl-case (wisi-cache-nonterm cache)
 770            (exception_handler
 771             ;; between 'when' and '=>'
 772             (+ (current-column) ada-indent-broken))
 773
 774            (if_expression
 775             (ada-wisi-indent-containing ada-indent-broken cache nil))
 776
 777            (select_alternative
 778             (ada-wisi-indent-containing (+ ada-indent-when ada-indent-broken) cache nil))
 779
 780            (t ;; other; normal block statement
 781             (ada-wisi-indent-cache ada-indent cache))
 782            ))
 783
 784         (close-paren
 785          ;; actual_parameter_part: test/ada_mode-nominal.adb
 786          ;; return 1.0 +
 787          ;;   Foo (Bar) + -- multi-line expression that happens to have a cache at a line start
 788          ;;   12;
 789          ;; indenting '12'; don't indent relative to containing function name
 790          ;;
 791          ;; attribute_designator: test/ada_mode-nominal.adb
 792          ;; raise Constraint_Error with Count'Image (Line (File)) &
 793          ;;    "foo";
 794          ;; indenting '"foo"'; relative to raise
 795          (when (memq (wisi-cache-nonterm cache)
 796                      '(actual_parameter_part attribute_designator))
 797            (setq cache (wisi-goto-containing cache)))
 798          (ada-wisi-indent-containing ada-indent-broken cache nil))
 799
 800         (list-break
 801          (ada-wisi-indent-list-break cache prev-token))
 802
 803         (open-paren
 804          ;; 1) A parenthesized expression, or the first item in an aggregate:
 805          ;;
 806          ;;    (foo +
 807          ;;       bar)
 808          ;;    (foo =>
 809          ;;       bar)
 810          ;;
 811          ;;     we are indenting 'bar'
 812          ;;
 813          ;; 2) A parenthesized expression, or the first item in an
 814          ;;    aggregate, and there is whitespace between
 815          ;;    ( and the first token:
 816          ;;
 817          ;; test/ada_mode-parens.adb
 818          ;; Local_9 : String := (
 819          ;;                      "123"
 820          ;;
 821          ;; 3) A parenthesized expression, or the first item in an
 822          ;;    aggregate, and there is a comment between
 823          ;;    ( and the first token:
 824          ;;
 825          ;; test/ada_mode-nominal.adb
 826          ;; A :=
 827          ;;   (
 828          ;;    -- a comment between paren and first association
 829          ;;    1 =>
 830          ;;
 831          (let ((paren-column (current-column))
 832                (start-is-comment (save-excursion (goto-char start) (looking-at comment-start-skip))))
 833            (wisi-forward-token t); point is now after paren
 834            (if start-is-comment
 835                (skip-syntax-forward " >"); point is now on comment
 836              (forward-comment (point-max)); point is now on first token
 837              )
 838            (if (= (point) start)
 839                ;; case 2) or 3)
 840                (1+ paren-column)
 841              ;; 1)
 842              (+ paren-column 1 ada-indent-broken))))
 843
 844         ((return-1 return-2)
 845          ;; hanging. Intent relative to line containing matching 'function'
 846          (ada-prev-statement-keyword)
 847          (back-to-indentation)
 848          (+ (current-column) ada-indent-broken))
 849
 850         (statement-end
 851          (ada-wisi-indent-containing 0 cache nil))
 852
 853         (statement-other
 854          (cl-ecase (wisi-cache-token cache)
 855            (ABORT
 856             ;; select
 857             ;;    Please_Abort;
 858             ;; then
 859             ;;   abort
 860             ;;    -- 'abort' indented with ada-indent-broken, since this is part
 861             ;;    Titi;
 862             (ada-wisi-indent-containing ada-indent cache))
 863
 864             ;; test/subdir/ada_mode-separate_task_body.adb
 865            ((COLON COLON_EQUAL)
 866             ;; Local_3 : constant Float :=
 867             ;;   Local_2;
 868             (ada-wisi-indent-cache ada-indent-broken cache))
 869
 870            (COMMA
 871             (cl-ecase (wisi-cache-nonterm cache)
 872               (name_list
 873                (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
 874                  (use_clause
 875                   ;; test/with_use1.adb
 876                   (ada-wisi-indent-containing ada-indent-use cache))
 877
 878                  (with_clause
 879                   ;; test/ada_mode-nominal.ads
 880                   ;; limited private with Ada.Strings.Bounded,
 881                   ;;   --EMACSCMD:(test-face "Ada.Containers" 'default)
 882                   ;;   Ada.Containers;
 883                   ;;
 884                   ;; test/with_use1.adb
 885                   (ada-wisi-indent-containing ada-indent-with cache))
 886                  ))
 887               ))
 888
 889            (ELSIF
 890             ;; test/g-comlin.adb
 891             ;; elsif Index_Switches + Max_Length <= Switches'Last
 892             ;;   and then Switches (Index_Switches + Max_Length) = '?'
 893             (ada-wisi-indent-cache ada-indent-broken cache))
 894
 895            (EQUAL_GREATER
 896             (cl-ecase (wisi-cache-nonterm (wisi-goto-containing cache nil))
 897               ((actual_parameter_part aggregate)
 898                ;; ada_mode-generic_package.ads
 899                ;; with package A_Package_2 is new Ada.Text_IO.Integer_IO (Num =>
 900                ;;                                                           Formal_Signed_Integer_Type);
 901                ;;  indenting 'Formal_Signed_...', point on '(Num'
 902                ;;
 903                ;; test/ada_mode-parens.adb
 904                ;; (1      =>
 905                ;;    1,
 906                ;; indenting '1,'; point on '(1'
 907                (+ (current-column) 1 ada-indent-broken))
 908
 909               (association_list
 910                ;; test/ada_mode-parens.adb
 911                ;; (1      =>
 912                ;;    1,
 913                ;;  2      =>
 914                ;;    1 + 2 * 3,
 915                ;; indending 1 +; point is on ',' after 1
 916                (wisi-indent-paren (1+ ada-indent-broken)))
 917
 918               ((case_expression_alternative case_statement_alternative exception_handler)
 919                ;; containing is 'when'
 920                (+ (current-column) ada-indent))
 921
 922               (generic_renaming_declaration
 923                ;; not indenting keyword following 'generic'
 924                (+ (current-column) ada-indent-broken))
 925
 926               (primary
 927                ;; test/ada_mode-quantified_expressions.adb
 928                ;; if (for some J in 1 .. 10 =>
 929                ;;       J/2 = 0)
 930                (ada-wisi-indent-containing ada-indent-broken cache))
 931
 932               ))
 933
 934            (IS
 935             (setq cache (wisi-goto-containing cache))
 936             (cl-ecase (wisi-cache-nonterm cache)
 937               (full_type_declaration
 938                ;; ada_mode/nominal.ads
 939                ;; type Limited_Derived_Type_1a is abstract limited new
 940                ;;    Private_Type_1 with record
 941                ;;       Component_1 : Integer;
 942                ;; indenting 'Private_Type_1'; look for 'record'
 943                (let ((type-column (current-column)))
 944                  (goto-char start)
 945                  (if (wisi-forward-find-token 'RECORD (line-end-position) t)
 946                      ;; 'record' on line being indented
 947                      (+ type-column ada-indent-record-rel-type)
 948                    ;; 'record' on later line
 949                    (+ type-column ada-indent-broken))))
 950
 951               ((formal_type_declaration
 952                 ;; test/ada_mode-generic_package.ads
 953                 ;; type Synchronized_Formal_Derived_Type is abstract synchronized new Formal_Private_Type and Interface_Type
 954                 ;;   with private;
 955
 956                 subtype_declaration)
 957                 ;; test/ada_mode-nominal.ads
 958                 ;;    subtype Subtype_2 is Signed_Integer_Type range 10 ..
 959                 ;;      20;
 960
 961                (+ (current-column) ada-indent-broken))
 962               ))
 963
 964            (LEFT_PAREN
 965             ;; test/indent.ads
 966             ;; C_S_Controls : constant
 967             ;;   CSCL_Type :=
 968             ;;     CSCL_Type'
 969             ;;       (
 970             ;;        1 =>
 971             (+ (current-column) 1))
 972
 973            (OF
 974             ;; ada_mode-nominal.ads
 975             ;; Anon_Array_2 : array (1 .. 10) of
 976             ;;   Integer;
 977             (ada-wisi-indent-containing ada-indent-broken cache))
 978
 979            (NEW
 980             ;; ada_mode-nominal.ads
 981             ;; type Limited_Derived_Type_2 is abstract limited new Private_Type_1 with
 982             ;;   private;
 983             (ada-wisi-indent-containing ada-indent-broken cache))
 984
 985            (WHEN
 986             ;; test/ada_mode-parens.adb
 987             ;; exit when A.all
 988             ;;   or else B.all
 989             (ada-wisi-indent-containing ada-indent-broken cache))
 990
 991            (WITH
 992             ;; extension aggregate: test/ada_mode-nominal-child.ads
 993             ;;      (Default_Parent with
 994             ;;       10, 12.0, True);
 995             ;;   indenting '10'; containing is '('
 996             ;;
 997             ;; raise_statement: test/ada_mode-nominal.adb
 998             ;; raise Constraint_Error with
 999             ;;    "help!";
1000             (cl-case (wisi-cache-nonterm cache)
1001               (aggregate
1002                (ada-wisi-indent-containing 0 cache nil))
1003
1004               (aspect_specification_opt
1005                ;; type Vector is tagged private
1006                ;;   with
1007                ;;     Constant_Indexing => Constant_Reference,
1008                ;; indenting 'Constant_Indexing'
1009                (+ (current-indentation) ada-indent-broken))
1010
1011               (raise_statement
1012                (ada-wisi-indent-containing ada-indent-broken cache nil))
1013               ))
1014
1015            ;; otherwise just hanging
1016            ((ACCEPT FUNCTION PROCEDURE RENAMES)
1017             (back-to-indentation)
1018             (+ (current-column) ada-indent-broken))
1019
1020           ))
1021
1022         (statement-start
1023          (cl-case (wisi-cache-token cache)
1024            (WITH ;; with_clause
1025             (+ (current-column) ada-indent-with))
1026
1027            (label_opt
1028             ;; comment after label
1029             (+ (current-column) (- ada-indent-label)))
1030
1031            (t
1032             ;; procedure Procedure_8
1033             ;;   is new Instance.Generic_Procedure (Integer, Function_1);
1034             ;; indenting 'is'; hanging
1035             ;;      (+ (current-column) ada-indent-broken))
1036             (ada-wisi-indent-cache ada-indent-broken cache))
1037            ))
1038         )))
1039     ))
1040
1041 (defun ada-wisi-comment ()
1042   "Compute indentation of a comment. For `wisi-indent-functions'."
1043   ;; We know we are at the first token on a line. We check for comment
1044   ;; syntax, not comment-start, to accomodate gnatprep, skeleton
1045   ;; placeholders, etc.
1046   (when (and (not (= (point) (point-max))) ;; no char after EOB!
1047              (= 11 (syntax-class (syntax-after (point)))))
1048
1049     ;; We are at a comment; indent to previous code or comment.
1050     (cond
1051      ((and ada-indent-comment-col-0
1052            (= 0 (current-column)))
1053       0)
1054
1055      ((or
1056        (save-excursion (forward-line -1) (looking-at "\\s *$"))
1057        (save-excursion (forward-comment -1)(not (looking-at comment-start))))
1058       ;; comment is after a blank line or code; indent as if code
1059       ;;
1060       ;; ada-wisi-before-cache will find the keyword _after_ the
1061       ;; comment, which could be a block-middle or block-end, and that
1062       ;; would align the comment with the block-middle, which is wrong. So
1063       ;; we only call ada-wisi-after-cache.
1064
1065       ;; FIXME: need option to match gnat style check; change indentation to match (ie mod 3)
1066       (ada-wisi-after-cache))
1067
1068       (t
1069        ;; comment is after a comment
1070        (forward-comment -1)
1071        (current-column))
1072       )))
1073
1074 (defun ada-wisi-post-parse-fail ()
1075   "For `wisi-post-parse-fail-hook'."
1076   (save-excursion
1077     (let ((start-cache (wisi-goto-start (or (wisi-get-cache (point)) (wisi-backward-cache)))))
1078       (when start-cache
1079         ;; nil when in a comment at point-min
1080         (indent-region (point) (wisi-cache-end start-cache)))
1081       ))
1082   (back-to-indentation))
1083
1084 ;;;; ada-mode functions (alphabetical)
1085
1086 (defun ada-wisi-declarative-region-start-p (cache)
1087   "Return t if cache is a keyword starting a declarative region."
1088   (cl-case (wisi-cache-token cache)
1089    (DECLARE t)
1090    (IS
1091     (memq (wisi-cache-class cache) '(block-start block-middle)))
1092    (t nil)
1093    ))
1094
1095 (defun ada-wisi-context-clause ()
1096   "For `ada-fix-context-clause'."
1097   (wisi-validate-cache (point-max))
1098   (save-excursion
1099     (goto-char (point-min))
1100     (let ((begin nil)
1101           (end nil)
1102           cache)
1103
1104       (while (not end)
1105         (setq cache (wisi-forward-cache))
1106         (cl-case (wisi-cache-nonterm cache)
1107           (pragma nil)
1108           (use_clause nil)
1109           (with_clause
1110            (when (not begin)
1111              (setq begin (point-at-bol))))
1112           (t
1113            ;; start of compilation unit
1114            (setq end (point-at-bol))
1115            (unless begin
1116              (setq begin end)))
1117           ))
1118       (cons begin end)
1119     )))
1120
1121 (defun ada-wisi-goto-declaration-start ()
1122   "For `ada-goto-declaration-start', which see.
1123 Also return cache at start."
1124   (wisi-validate-cache (point))
1125   (let ((cache (wisi-get-cache (point)))
1126         (done nil))
1127     (unless cache
1128       (setq cache (wisi-backward-cache)))
1129     ;; cache is null at bob
1130     (while (not done)
1131       (if cache
1132           (progn
1133             (setq done
1134                   (cl-case (wisi-cache-nonterm cache)
1135                     ((generic_package_declaration generic_subprogram_declaration)
1136                      (eq (wisi-cache-token cache) 'GENERIC))
1137
1138                     ((package_body package_declaration)
1139                      (eq (wisi-cache-token cache) 'PACKAGE))
1140
1141                     ((protected_body protected_type_declaration single_protected_declaration)
1142                      (eq (wisi-cache-token cache) 'PROTECTED))
1143
1144                     ((subprogram_body subprogram_declaration null_procedure_declaration)
1145                      (memq (wisi-cache-token cache) '(NOT OVERRIDING FUNCTION PROCEDURE)))
1146
1147                     (task_type_declaration
1148                      (eq (wisi-cache-token cache) 'TASK))
1149
1150                     ))
1151             (unless done
1152               (setq cache (wisi-goto-containing cache nil))))
1153         (setq done t))
1154         )
1155     cache))
1156
1157 (defun ada-wisi-goto-declarative-region-start ()
1158   "For `ada-goto-declarative-region-start', which see."
1159   (wisi-validate-cache (point))
1160   (let ((done nil)
1161         (first t)
1162         (cache
1163          (or
1164           (wisi-get-cache (point))
1165           ;; we use forward-cache here, to handle the case where point is after a subprogram declaration:
1166           ;; declare
1167           ;;     ...
1168           ;;     function ... is ... end;
1169           ;;     <point>
1170           ;;     function ... is ... end;
1171           (wisi-forward-cache))))
1172     (while (not done)
1173       (if (ada-wisi-declarative-region-start-p cache)
1174           (progn
1175             (wisi-forward-token t)
1176             (setq done t))
1177         (cl-case (wisi-cache-class cache)
1178           ((block-middle block-end)
1179            (setq cache (wisi-prev-statement-cache cache)))
1180
1181           (statement-start
1182            ;; 1) test/ada_mode-nominal.adb
1183            ;;    protected body Protected_1 is -- target 2
1184            ;;        <point>
1185            ;;    want target 2
1186            ;;
1187            ;; 2) test/ada_mode-nominal.adb
1188            ;;    function Function_Access_1
1189            ;;      (A_Param <point> : in Float)
1190            ;;      return
1191            ;;        Standard.Float
1192            ;;    is -- target 1
1193            ;;    want target 1
1194            ;;
1195            ;; 3) test/ada_mode-nominal-child.adb
1196            ;;    overriding <point> function Function_2c (Param : in Child_Type_1)
1197            ;;                                    return Float
1198            ;;    is -- target Function_2c
1199            ;;    want target
1200
1201            (if first
1202                ;; case 1
1203                (setq cache (wisi-goto-containing cache t))
1204              ;; case 2, 3
1205              (cl-case (wisi-cache-nonterm cache)
1206                (subprogram_body
1207                 (while (not (eq 'IS (wisi-cache-token cache)))
1208                   (setq cache (wisi-next-statement-cache cache))))
1209                (t
1210                 (setq cache (wisi-goto-containing cache t)))
1211                )))
1212           (t
1213            (setq cache (wisi-goto-containing cache t)))
1214           ))
1215       (when first (setq first nil)))
1216     ))
1217
1218 (defun ada-wisi-in-paramlist-p ()
1219   "For `ada-in-paramlist-p'."
1220   (wisi-validate-cache (point))
1221   ;; (info "(elisp)Parser State" "*syntax-ppss*")
1222   (let* ((parse-result (syntax-ppss))
1223          cache)
1224     (and (> (nth 0 parse-result) 0)
1225          ;; cache is nil if the parse failed
1226          (setq cache (wisi-get-cache (nth 1 parse-result)))
1227          (eq 'formal_part (wisi-cache-nonterm cache)))
1228     ))
1229
1230 (defun ada-wisi-make-subprogram-body ()
1231   "For `ada-make-subprogram-body'."
1232   (wisi-validate-cache (point))
1233   (when wisi-parse-failed
1234     (error "syntax parse failed; cannot create body"))
1235
1236   (let* ((begin (point))
1237          (end (save-excursion (wisi-forward-find-class 'statement-end (point-max)) (point)))
1238          (cache (wisi-forward-find-class 'name end))
1239          (name (buffer-substring-no-properties
1240                 (point)
1241                 (+ (point) (wisi-cache-last cache)))))
1242     (goto-char end)
1243     (newline)
1244     (insert " is begin\nnull;\nend ");; legal syntax; parse does not fail
1245     (insert name)
1246     (forward-char 1)
1247
1248     ;; newline after body to separate from next body
1249     (newline-and-indent)
1250     (indent-region begin (point))
1251     (forward-line -2)
1252     (back-to-indentation); before 'null;'
1253     ))
1254
1255 (defun ada-wisi-scan-paramlist (begin end)
1256   "For `ada-scan-paramlist'."
1257   (wisi-validate-cache end)
1258   (goto-char begin)
1259   (let (token
1260         text
1261         identifiers
1262         (in-p nil)
1263         (out-p nil)
1264         (not-null-p nil)
1265         (access-p nil)
1266         (constant-p nil)
1267         (protected-p nil)
1268         (type nil)
1269         type-begin
1270         type-end
1271         (default nil)
1272         (default-begin nil)
1273         param
1274         paramlist
1275         (done nil))
1276     (while (not done)
1277       (let ((token-text (wisi-forward-token)))
1278         (setq token (nth 0 token-text))
1279         (setq text  (nth 1 token-text)))
1280       (cond
1281        ((equal token 'COMMA) nil);; multiple identifiers
1282
1283        ((equal token 'COLON)
1284         ;; identifiers done. find type-begin; there may be no mode
1285         (skip-syntax-forward " ")
1286         (setq type-begin (point))
1287         (save-excursion
1288           (while (member (car (wisi-forward-token)) '(IN OUT NOT NULL ACCESS CONSTANT PROTECTED))
1289             (skip-syntax-forward " ")
1290             (setq type-begin (point)))))
1291
1292        ((equal token 'IN) (setq in-p t))
1293        ((equal token 'OUT) (setq out-p t))
1294        ((and (not type-end)
1295              (member token '(NOT NULL)))
1296         ;; "not", "null" could be part of the default expression
1297         (setq not-null-p t))
1298        ((equal token 'ACCESS) (setq access-p t))
1299        ((equal token 'CONSTANT) (setq constant-p t))
1300        ((equal token 'PROTECTED) (setq protected-p t))
1301
1302        ((equal token 'COLON_EQUAL)
1303         (setq type-end (save-excursion (backward-char 2) (skip-syntax-backward " ") (point)))
1304         (skip-syntax-forward " ")
1305         (setq default-begin (point))
1306         (wisi-forward-find-token 'SEMICOLON end t))
1307
1308        ((member token '(SEMICOLON RIGHT_PAREN))
1309         (if (equal token 'RIGHT_PAREN)
1310             ;; all done
1311             (progn
1312               (setq done t)
1313               (when (not type-end) (setq type-end (1- (point))))
1314               (when default-begin (setq default (buffer-substring-no-properties default-begin (1- (point)))))
1315               )
1316           ;; else semicolon - one param done
1317           (when (not type-end) (setq type-end (1- (point))))
1318           (when default-begin (setq default (buffer-substring-no-properties default-begin (1- (point)))))
1319           )
1320
1321         (setq type (buffer-substring-no-properties type-begin type-end))
1322         (setq param (list (reverse identifiers)
1323                           in-p out-p not-null-p access-p constant-p protected-p
1324                           type default))
1325         (if paramlist
1326             (add-to-list 'paramlist param)
1327           (setq paramlist (list param)))
1328         (setq identifiers nil
1329               in-p nil
1330               out-p nil
1331               not-null-p nil
1332               access-p nil
1333               constant-p nil
1334               protected-p nil
1335               type nil
1336               type-begin nil
1337               type-end nil
1338               default nil
1339               default-begin nil))
1340
1341        (t
1342         (when (not type-begin)
1343           (if identifiers
1344               (add-to-list 'identifiers text)
1345             (setq identifiers (list text)))))
1346        ))
1347     paramlist))
1348
1349 (defun ada-wisi-which-function-1 (keyword add-body)
1350   "used in `ada-wisi-which-function'."
1351   (let (region
1352         result
1353         (cache (wisi-forward-find-class 'name (point-max))))
1354
1355     (setq result (wisi-cache-text cache))
1356
1357     (when (not ff-function-name)
1358       (setq ff-function-name
1359             (concat
1360              keyword
1361              (when add-body "\\s-+body")
1362              "\\s-+"
1363              result
1364              ada-symbol-end)))
1365     result))
1366
1367 (defun ada-wisi-which-function ()
1368   "For `ada-which-function'."
1369   (wisi-validate-cache (point))
1370   (save-excursion
1371     (let ((result nil)
1372           (cache (ada-wisi-goto-declaration-start)))
1373       (if (null cache)
1374           ;; bob
1375           (setq result "")
1376
1377         (cl-case (wisi-cache-nonterm cache)
1378           ((generic_package_declaration generic_subprogram_declaration)
1379            ;; name is after next statement keyword
1380            (wisi-next-statement-cache cache)
1381            (setq cache (wisi-get-cache (point))))
1382           )
1383
1384         ;; add or delete 'body' as needed
1385         (cl-ecase (wisi-cache-nonterm cache)
1386           (package_body
1387            (setq result (ada-wisi-which-function-1 "package" nil)))
1388
1389           ((package_declaration
1390             generic_package_declaration) ;; after 'generic'
1391            (setq result (ada-wisi-which-function-1 "package" t)))
1392
1393           (protected_body
1394            (setq result (ada-wisi-which-function-1 "protected" nil)))
1395
1396           ((protected_type_declaration single_protected_declaration)
1397            (setq result (ada-wisi-which-function-1 "protected" t)))
1398
1399           ((subprogram_declaration
1400             subprogram_specification ;; after 'generic'
1401             null_procedure_declaration)
1402            (setq result (ada-wisi-which-function-1
1403                          (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
1404                          nil))) ;; no 'body' keyword in subprogram bodies
1405
1406           (subprogram_body
1407            (setq result (ada-wisi-which-function-1
1408                          (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
1409                          nil)))
1410
1411           (task_type_declaration
1412            (setq result (ada-wisi-which-function-1 "task" t)))
1413
1414           ))
1415       result)))
1416
1417 ;;;; debugging
1418 (defun ada-wisi-debug-keys ()
1419   "Add debug key definitions to `ada-mode-map'."
1420   (interactive)
1421   (define-key ada-mode-map "\M-e" 'wisi-show-parse-error)
1422   (define-key ada-mode-map "\M-h" 'wisi-show-containing-or-previous-cache)
1423   (define-key ada-mode-map "\M-i" 'wisi-goto-end)
1424   (define-key ada-mode-map "\M-j" 'wisi-show-cache)
1425   (define-key ada-mode-map "\M-k" 'wisi-show-token)
1426   )
1427
1428 (defun ada-wisi-setup ()
1429   "Set up a buffer for parsing Ada files with wisi."
1430   (wisi-setup '(ada-wisi-comment
1431                 ada-wisi-before-cache
1432                 ada-wisi-after-cache)
1433               'ada-wisi-post-parse-fail
1434               ada-wisi-class-list
1435               ada-grammar-wy--keyword-table
1436               ada-grammar-wy--token-table
1437               ada-grammar-wy--parse-table)
1438   (setq wisi-string-quote-escape-doubled t)
1439
1440   (set (make-local-variable 'comment-indent-function) 'wisi-comment-indent)
1441
1442   (add-hook 'hack-local-variables-hook 'ada-wisi-post-local-vars nil t)
1443   )
1444
1445 (defun ada-wisi-post-local-vars ()
1446   ;; run after file local variables are read because font-lock-add-keywords
1447   ;; evaluates font-lock-defaults, which depends on ada-language-version.
1448   (font-lock-add-keywords 'ada-mode
1449    ;; use keyword cache to distinguish between 'function ... return <type>;' and 'return ...;'
1450    (list
1451     (list
1452      (concat
1453       "\\<\\("
1454       "return[ \t]+access[ \t]+constant\\|"
1455       "return[ \t]+access\\|"
1456       "return"
1457       "\\)\\>[ \t]*"
1458       ada-name-regexp "?")
1459      '(1 font-lock-keyword-face)
1460      '(2 (if (eq (when (not (ada-in-string-or-comment-p))
1461                    (wisi-validate-cache (match-end 2))
1462                    (and (wisi-get-cache (match-beginning 2))
1463                         (wisi-cache-class (wisi-get-cache (match-beginning 2)))))
1464                  'type)
1465              font-lock-type-face
1466            'default)
1467          nil t)
1468      )))
1469
1470   (when global-font-lock-mode
1471     ;; ensure the modified keywords are applied
1472     (font-lock-refresh-defaults))
1473   )
1474
1475 (add-hook 'ada-mode-hook 'ada-wisi-setup)
1476
1477 (setq ada-fix-context-clause 'ada-wisi-context-clause)
1478 (setq ada-goto-declaration-start 'ada-wisi-goto-declaration-start)
1479 (setq ada-goto-declarative-region-start 'ada-wisi-goto-declarative-region-start)
1480 (setq ada-goto-end 'wisi-goto-end)
1481 (setq ada-in-paramlist-p 'ada-wisi-in-paramlist-p)
1482 (setq ada-indent-statement 'wisi-indent-statement)
1483 (setq ada-make-subprogram-body 'ada-wisi-make-subprogram-body)
1484 (setq ada-next-statement-keyword 'wisi-forward-statement-keyword)
1485 (setq ada-prev-statement-keyword 'wisi-backward-statement-keyword)
1486 (setq ada-reset-parser 'wisi-invalidate-cache)
1487 (setq ada-scan-paramlist 'ada-wisi-scan-paramlist)
1488 (setq ada-show-parse-error 'wisi-show-parse-error)
1489 (setq ada-which-function 'ada-wisi-which-function)
1490
1491 (provide 'ada-wisi)
1492 (provide 'ada-indent-engine)
1493
1494 ;; end of file