1 ;;; An indentation engine for Ada mode, using the wisi generalized LALR parser
3 ;; [1] ISO/IEC 8652:2012(E); Ada 2012 reference manual
5 ;; Copyright (C) 2012 - 2014 Free Software Foundation, Inc.
7 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
9 ;; This file is part of GNU Emacs.
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.
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.
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/>.
26 ;; implementation started Jan 2013
30 (require 'ada-fix-error)
31 (require 'ada-grammar-wy)
32 (require 'ada-indent-user-options)
36 (defconst ada-wisi-class-list
39 block-middle ;; not start of statement
40 block-start ;; start of block is start of statement
44 name-paren ;; anything that looks like a procedure call, since the grammar can't distinguish most of them
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))
64 (let ((cache (wisi-get-cache (point))))
66 (eq 'open-paren (wisi-cache-class cache)))
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)))
77 ((eq 'LEFT_PAREN (wisi-cache-token cache))
78 ;; test/ada_mode-long_paren.adb
82 ;; (RX_Torque_Subaddress |
85 ;; test/ada_mode-parens.adb
89 ;; indenting '(local_6)'; 'offset' = ada-indent - 1
90 (+ (current-column) 1 offset))
93 (let ((containing (wisi-goto-containing-paren cache)))
95 ;; test/ada_mode-conditional_expressions.adb
96 ;; K2 : Integer := (if J > 42
98 ;; indenting 'then'; offset = 0
100 ;; L1 : Integer := (case J is
104 ;; C_S_Controls : constant
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)))))
115 ;; all other structures
117 ;; current cache may be preceded by something on same
118 ;; line. Handle common cases nicely.
121 (not (= (current-column) indent))
122 (eq 'EQUAL_GREATER (wisi-cache-token cache))))
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)))
132 ;; test/ada_mode-opentoken.ads
133 ;; private package GDS.Commands.Add_Statement is
134 ;; type Instance is new Nonterminal.Instance with null record;
137 ((eq 'label_opt (wisi-cache-token cache))
138 (+ indent (- ada-indent-label) offset))
141 ;; test/ada_mode-generic_instantiation.ads
142 ;; function Function_1 is new Instance.Generic_Function
143 ;; (Param_Type => Integer,
145 ;; test/ada_mode-nested_packages.adb
146 ;; function Create (Model : in Integer;
147 ;; Context : in String) return String is
149 ;; Cache : array (1 .. 10) of Boolean := (True, False, others => False);
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."
159 ((markerp (wisi-cache-containing cache))
160 (ada-wisi-indent-cache offset (wisi-goto-containing cache)))
165 (ada-goto-open-paren 1)
166 (+ (current-column) offset))
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))
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)
185 (if (equal break-point (cl-caddr prev-token))
186 ;; we are indenting the first token after the list-break; not hanging.
189 ;; Append_To (Formals,
190 ;; Make_Parameter_Specification (Loc,
191 ;; indenting 'Make_...'
193 ;; test/ada_mode-generic_instantiation.ads
194 ;; function Function_1 is new Instance.Generic_Function
195 ;; (Param_Type => Integer,
196 ;; Result_Type => Boolean,
198 ;; indenting 'Result_Type'
199 (+ (current-column) 1)
202 ;; test/ada_mode-parens.adb
209 (+ (current-column) 1 ada-indent-broken)))
212 ;; test/ada_mode-conditional_expressions.adb
213 ;; L1 : Integer := (case J is
215 ;; -- comment aligned with 'when'
216 ;; indenting '-- comment'
217 (wisi-indent-paren (+ 1 ada-indent-when)))
220 (cl-ecase (wisi-cache-nonterm containing)
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))
229 (aspect_specification_opt
231 ;; type Vector is tagged private
233 ;; Constant_Indexing => Constant_Reference,
234 ;; Variable_Indexing => Reference,
235 ;; indenting 'Variable_Indexing'
236 (+ (current-indentation) ada-indent-broken))
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)))
248 (cl-ecase (wisi-cache-class cache)
250 (cl-case (wisi-cache-token cache)
251 (IS ;; subprogram body
252 (ada-wisi-indent-containing 0 cache t))
255 ;; test/ada_mode-nominal.ads; ada-indent-record-rel-type = 3
256 ;; type Private_Type_2 is abstract tagged limited
258 ;; indenting 'record'
260 ;; type Limited_Derived_Type_1d is
261 ;; abstract limited new Private_Type_1 with
263 ;; indenting 'record'
265 ;; for Record_Type_1 use
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)))
274 (ada-wisi-indent-containing ada-indent cache t))))
277 (cl-case (wisi-cache-nonterm cache)
280 (wisi-goto-containing cache);; now on 'record'
281 (current-indentation)))
284 (ada-wisi-indent-containing 0 cache t))
288 (cl-case (wisi-cache-token cache)
290 (ada-wisi-indent-containing ada-indent-when cache t))
293 (ada-wisi-indent-containing 0 cache t))
296 (close-paren (wisi-indent-paren 0))
299 (ada-wisi-indent-containing ada-indent-broken cache t))
302 (let ((containing (wisi-goto-containing cache)))
303 (cl-case (wisi-cache-class containing)
305 ;; test/ada_mode-slices.adb
306 ;; Put_Line(Day'Image(D1) & " - " & Day'Image(D2) & " = " &
307 ;; Integer'Image(N));
309 ;; test/ada_mode-parens.adb
312 ;; indenting 'Integer'
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)
323 (+ paren-column 1 ada-indent-broken))))
326 (ada-wisi-indent-list-break containing prev-token))
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))
337 (let ((containing (wisi-goto-containing cache)))
338 (cl-case (wisi-cache-token containing)
340 ;; test/ada_mode-parens.adb
341 ;; A : Matrix_Type :=
345 (ada-wisi-indent-containing 0 containing))
348 (setq containing (wisi-goto-containing containing))
349 (cl-ecase (wisi-cache-token containing)
351 ;; test/ada_mode-long_paren.adb
355 ;; (RX_Torque_Subaddress |
356 ;; indenting (RX_Torque
357 (ada-wisi-indent-containing ada-indent-broken containing t))
359 ;; test/ada_mode-parens.adb
362 ;; indenting '(1 => 12'; containing is '=>'
363 (ada-wisi-indent-cache (1- ada-indent) containing))
365 ;; test/ada_mode-conditional_expressions.adb
368 ;; indenting '(if'; containing is '=>'
369 (+ (current-column) -1 ada-indent))
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)
380 ;; Standard.Float -- Ada mode 4.01, GPS do this differently
381 ;; indenting second '(A_Param)
382 (+ (current-indentation) -1 ada-indent))
385 ;; test/ada_mode-parens.adb
391 (+ (current-column) 1 ada-indent-broken))
394 ;; test/ada_mode-nominal.adb
396 ;; when Local_1 = 0 and not
398 ;; indenting (Local_2
401 ;; (X : Integer) when Local_1 = 0 and not
403 (+ (ada-wisi-current-indentation) ada-indent-broken))
411 ;; test/ada_mode-parens.adb
419 ;; test/ada_mode-parens.adb
420 ;; Local_11 : Local_11_Type := Local_11_Type'
425 (+ (ada-wisi-current-indentation) ada-indent-broken))
429 ((memq (wisi-cache-class containing) '(block-start statement-start))
430 ;; test/ada_mode-nominal.adb
434 (ada-wisi-indent-cache ada-indent-broken containing))
437 ;; Open paren in an expression.
439 ;; test/ada_mode-conditional_expressions.adb
441 ;; (case J is when 42 => -1, when Integer'First .. 41 => 0, when others => 1);
443 (ada-wisi-indent-containing ada-indent-broken containing t))
447 (return-1;; parameter list
448 (let ((return-pos (point)))
449 (wisi-goto-containing cache nil) ;; matching 'function'
451 ((<= ada-indent-return 0)
452 ;; indent relative to "("
453 (wisi-forward-find-class 'open-paren return-pos)
454 (+ (current-column) (- ada-indent-return)))
457 (+ (current-column) ada-indent-return))
460 (return-2;; no parameter list
461 (wisi-goto-containing cache nil) ;; matching 'function'
462 (+ (current-column) ada-indent-broken))
465 (ada-wisi-indent-containing ada-indent-broken cache t))
468 (let ((containing (wisi-goto-containing cache nil)))
469 (cl-case (wisi-cache-token cache)
471 (+ (current-column) ada-indent-broken))
475 ;; elsif Current_Argument < CL.Argument_Count then
476 (ada-wisi-indent-cache 0 containing))
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))
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)))
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))
497 (goto-char pos-subprogram)
498 (+ (current-indentation) ada-indent-broken))
501 (object_renaming_declaration
502 (+ (current-indentation) ada-indent-broken))
506 (while (not (wisi-cache-nonterm containing))
507 (setq containing (wisi-goto-containing containing)))
509 (cl-ecase (wisi-cache-nonterm containing)
512 (+ (current-column) 1))
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))
523 (+ (current-column) ada-indent-broken))
525 (component_declaration
526 ;; test/ada_mode-nominal.ads record_type_3
527 (+ (current-column) ada-indent-broken))
531 (+ (current-column) ada-indent-broken))
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);
538 (+ (current-column) ada-indent-broken))
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;
546 ;; type Object_Access_Type_7
547 ;; is access all Integer;
550 ;; type Limited_Derived_Type_1 is abstract limited new Private_Type_1 with
552 ;; indenting 'record'
554 ;; type Limited_Derived_Type_3 is abstract limited new Private_Type_1
558 ;; type Limited_Derived_Type_2a is abstract limited new Private_Type_1
560 ;; indenting 'with record'
561 (while (not (eq 'TYPE (wisi-cache-token containing)))
562 (setq containing (wisi-goto-containing containing)))
565 ((eq (wisi-cache-token cache) 'RECORD)
566 (+ (current-column) ada-indent-record-rel-type))
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))))
577 (+ (current-column) ada-indent-broken))
580 (generic_instantiation
581 ;; test/ada_mode-generic_instantiation.ads
582 ;; procedure Procedure_7 is
583 ;; new Instance.Generic_Procedure (Integer, Function_1);
585 (+ (current-column) ada-indent-broken))
587 (generic_renaming_declaration
588 ;; indenting keyword following 'generic'
592 (cl-ecase (wisi-cache-token containing)
594 ;; test/ada_mode-nominal.ads
595 ;; Anon_Array_3 : array (1 .. 10)
598 (+ (current-indentation) ada-indent-broken))
602 ;; C_S_Controls : constant
605 ;; indenting 'CSCL_Type'
606 (+ (current-indentation) ada-indent-broken))
609 ;; test/ada_mode-nominal.adb
610 ;; Local_2 : constant Float
612 (+ (current-indentation) ada-indent-broken))
615 (private_type_declaration
617 ;; type Vector is tagged private
620 (+ (current-indentation) ada-indent-broken))
622 (qualified_expression
623 ;; test/ada_mode-nominal-child.ads
624 ;; Child_Obj_5 : constant Child_Type_1 :=
626 ;; (Parent_Element_1 => 1,
627 (ada-wisi-indent-cache ada-indent-broken containing))
630 (cl-case (wisi-cache-token containing)
632 (- (current-column) ada-indent-label))
635 ;; test/ada_mode-nominal.adb
641 (ada-wisi-indent-cache ada-indent-broken cache))
644 ((subprogram_body subprogram_declaration subprogram_specification null_procedure_declaration)
645 (cl-ecase (wisi-cache-token cache)
647 ;; indenting 'overriding' following 'not'
650 ((PROCEDURE FUNCTION)
651 ;; indenting 'procedure' or 'function following 'overriding'
656 ;; test/adacore_9717_001.ads A_Long_Name
657 (+ (current-column) ada-indent-broken))
659 ))))) ;; end statement-other
663 ((eq 'label_opt (wisi-cache-token cache))
664 (ada-wisi-indent-containing (+ ada-indent-label ada-indent) cache t))
667 (let ((containing-cache (wisi-get-containing-cache cache)))
668 (if (not containing-cache)
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)
677 (+ (current-indentation) ada-indent))
680 (ada-wisi-indent-cache ada-indent containing-cache))
684 (ada-wisi-indent-list-break cache prev-token))
687 (cl-case (wisi-cache-token containing-cache)
689 ;; test/ada_mode-parens.adb
692 ;; indenting 'Integer'
693 (wisi-indent-paren 1))
696 ;; test/ada_mode-nested_packages.adb
698 ;; when Io.Name_Error =>
700 (ada-wisi-indent-containing ada-indent containing-cache 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))
713 (ada-wisi-indent-containing ada-indent-broken cache t))
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)))
729 (while (memq (wisi-cache-class cache) '(name name-paren type))
730 ;; not useful for indenting
731 (setq cache (wisi-backward-cache)))
733 (cl-ecase (wisi-cache-class cache)
735 ;; indenting block/subprogram name after 'end'
736 (wisi-indent-current ada-indent-broken))
739 (cl-case (wisi-cache-token cache)
741 (cl-case (wisi-cache-nonterm cache)
743 ;; between 'case .. is' and first 'when'; most likely a comment
744 (ada-wisi-indent-containing 0 cache t))
747 (+ (ada-wisi-indent-containing ada-indent cache t)))
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)))
758 ;; between 'when' and '=>'
759 (+ (current-column) ada-indent-broken))
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))
769 (cl-case (wisi-cache-nonterm cache)
771 ;; between 'when' and '=>'
772 (+ (current-column) ada-indent-broken))
775 (ada-wisi-indent-containing ada-indent-broken cache nil))
778 (ada-wisi-indent-containing (+ ada-indent-when ada-indent-broken) cache nil))
780 (t ;; other; normal block statement
781 (ada-wisi-indent-cache ada-indent cache))
785 ;; actual_parameter_part: test/ada_mode-nominal.adb
787 ;; Foo (Bar) + -- multi-line expression that happens to have a cache at a line start
789 ;; indenting '12'; don't indent relative to containing function name
791 ;; attribute_designator: test/ada_mode-nominal.adb
792 ;; raise Constraint_Error with Count'Image (Line (File)) &
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))
801 (ada-wisi-indent-list-break cache prev-token))
804 ;; 1) A parenthesized expression, or the first item in an aggregate:
811 ;; we are indenting 'bar'
813 ;; 2) A parenthesized expression, or the first item in an
814 ;; aggregate, and there is whitespace between
815 ;; ( and the first token:
817 ;; test/ada_mode-parens.adb
818 ;; Local_9 : String := (
821 ;; 3) A parenthesized expression, or the first item in an
822 ;; aggregate, and there is a comment between
823 ;; ( and the first token:
825 ;; test/ada_mode-nominal.adb
828 ;; -- a comment between paren and first association
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
835 (skip-syntax-forward " >"); point is now on comment
836 (forward-comment (point-max)); point is now on first token
838 (if (= (point) start)
842 (+ paren-column 1 ada-indent-broken))))
845 ;; hanging. Intent relative to line containing matching 'function'
846 (ada-prev-statement-keyword)
847 (back-to-indentation)
848 (+ (current-column) ada-indent-broken))
851 (ada-wisi-indent-containing 0 cache nil))
854 (cl-ecase (wisi-cache-token cache)
860 ;; -- 'abort' indented with ada-indent-broken, since this is part
862 (ada-wisi-indent-containing ada-indent cache))
864 ;; test/subdir/ada_mode-separate_task_body.adb
866 ;; Local_3 : constant Float :=
868 (ada-wisi-indent-cache ada-indent-broken cache))
871 (cl-ecase (wisi-cache-nonterm cache)
873 (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
875 ;; test/with_use1.adb
876 (ada-wisi-indent-containing ada-indent-use cache))
879 ;; test/ada_mode-nominal.ads
880 ;; limited private with Ada.Strings.Bounded,
881 ;; --EMACSCMD:(test-face "Ada.Containers" 'default)
884 ;; test/with_use1.adb
885 (ada-wisi-indent-containing ada-indent-with cache))
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))
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'
903 ;; test/ada_mode-parens.adb
906 ;; indenting '1,'; point on '(1'
907 (+ (current-column) 1 ada-indent-broken))
910 ;; test/ada_mode-parens.adb
915 ;; indending 1 +; point is on ',' after 1
916 (wisi-indent-paren (1+ ada-indent-broken)))
918 ((case_expression_alternative case_statement_alternative exception_handler)
919 ;; containing is 'when'
920 (+ (current-column) ada-indent))
922 (generic_renaming_declaration
923 ;; not indenting keyword following 'generic'
924 (+ (current-column) ada-indent-broken))
927 ;; test/ada_mode-quantified_expressions.adb
928 ;; if (for some J in 1 .. 10 =>
930 (ada-wisi-indent-containing ada-indent-broken cache))
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)))
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))))
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
957 ;; test/ada_mode-nominal.ads
958 ;; subtype Subtype_2 is Signed_Integer_Type range 10 ..
961 (+ (current-column) ada-indent-broken))
966 ;; C_S_Controls : constant
971 (+ (current-column) 1))
974 ;; ada_mode-nominal.ads
975 ;; Anon_Array_2 : array (1 .. 10) of
977 (ada-wisi-indent-containing ada-indent-broken cache))
980 ;; ada_mode-nominal.ads
981 ;; type Limited_Derived_Type_2 is abstract limited new Private_Type_1 with
983 (ada-wisi-indent-containing ada-indent-broken cache))
986 ;; test/ada_mode-parens.adb
989 (ada-wisi-indent-containing ada-indent-broken cache))
992 ;; extension aggregate: test/ada_mode-nominal-child.ads
993 ;; (Default_Parent with
995 ;; indenting '10'; containing is '('
997 ;; raise_statement: test/ada_mode-nominal.adb
998 ;; raise Constraint_Error with
1000 (cl-case (wisi-cache-nonterm cache)
1002 (ada-wisi-indent-containing 0 cache nil))
1004 (aspect_specification_opt
1005 ;; type Vector is tagged private
1007 ;; Constant_Indexing => Constant_Reference,
1008 ;; indenting 'Constant_Indexing'
1009 (+ (current-indentation) ada-indent-broken))
1012 (ada-wisi-indent-containing ada-indent-broken cache nil))
1015 ;; otherwise just hanging
1016 ((ACCEPT FUNCTION PROCEDURE RENAMES)
1017 (back-to-indentation)
1018 (+ (current-column) ada-indent-broken))
1023 (cl-case (wisi-cache-token cache)
1024 (WITH ;; with_clause
1025 (+ (current-column) ada-indent-with))
1028 ;; comment after label
1029 (+ (current-column) (- ada-indent-label)))
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))
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)))))
1049 ;; We are at a comment; indent to previous code or comment.
1051 ((and ada-indent-comment-col-0
1052 (= 0 (current-column)))
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
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.
1065 ;; FIXME: need option to match gnat style check; change indentation to match (ie mod 3)
1066 (ada-wisi-after-cache))
1069 ;; comment is after a comment
1070 (forward-comment -1)
1074 (defun ada-wisi-post-parse-fail ()
1075 "For `wisi-post-parse-fail-hook'."
1077 (let ((start-cache (wisi-goto-start (or (wisi-get-cache (point)) (wisi-backward-cache)))))
1079 ;; nil when in a comment at point-min
1080 (indent-region (point) (wisi-cache-end start-cache)))
1082 (back-to-indentation))
1084 ;;;; ada-mode functions (alphabetical)
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)
1091 (memq (wisi-cache-class cache) '(block-start block-middle)))
1095 (defun ada-wisi-context-clause ()
1096 "For `ada-fix-context-clause'."
1097 (wisi-validate-cache (point-max))
1099 (goto-char (point-min))
1105 (setq cache (wisi-forward-cache))
1106 (cl-case (wisi-cache-nonterm cache)
1111 (setq begin (point-at-bol))))
1113 ;; start of compilation unit
1114 (setq end (point-at-bol))
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)))
1128 (setq cache (wisi-backward-cache)))
1129 ;; cache is null at bob
1134 (cl-case (wisi-cache-nonterm cache)
1135 ((generic_package_declaration generic_subprogram_declaration)
1136 (eq (wisi-cache-token cache) 'GENERIC))
1138 ((package_body package_declaration)
1139 (eq (wisi-cache-token cache) 'PACKAGE))
1141 ((protected_body protected_type_declaration single_protected_declaration)
1142 (eq (wisi-cache-token cache) 'PROTECTED))
1144 ((subprogram_body subprogram_declaration null_procedure_declaration)
1145 (memq (wisi-cache-token cache) '(NOT OVERRIDING FUNCTION PROCEDURE)))
1147 (task_type_declaration
1148 (eq (wisi-cache-token cache) 'TASK))
1152 (setq cache (wisi-goto-containing cache nil))))
1157 (defun ada-wisi-goto-declarative-region-start ()
1158 "For `ada-goto-declarative-region-start', which see."
1159 (wisi-validate-cache (point))
1164 (wisi-get-cache (point))
1165 ;; we use forward-cache here, to handle the case where point is after a subprogram declaration:
1168 ;; function ... is ... end;
1170 ;; function ... is ... end;
1171 (wisi-forward-cache))))
1173 (if (ada-wisi-declarative-region-start-p cache)
1175 (wisi-forward-token t)
1177 (cl-case (wisi-cache-class cache)
1178 ((block-middle block-end)
1179 (setq cache (wisi-prev-statement-cache cache)))
1182 ;; 1) test/ada_mode-nominal.adb
1183 ;; protected body Protected_1 is -- target 2
1187 ;; 2) test/ada_mode-nominal.adb
1188 ;; function Function_Access_1
1189 ;; (A_Param <point> : in Float)
1195 ;; 3) test/ada_mode-nominal-child.adb
1196 ;; overriding <point> function Function_2c (Param : in Child_Type_1)
1198 ;; is -- target Function_2c
1203 (setq cache (wisi-goto-containing cache t))
1205 (cl-case (wisi-cache-nonterm cache)
1207 (while (not (eq 'IS (wisi-cache-token cache)))
1208 (setq cache (wisi-next-statement-cache cache))))
1210 (setq cache (wisi-goto-containing cache t)))
1213 (setq cache (wisi-goto-containing cache t)))
1215 (when first (setq first nil)))
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))
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)))
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"))
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
1241 (+ (point) (wisi-cache-last cache)))))
1244 (insert " is begin\nnull;\nend ");; legal syntax; parse does not fail
1248 ;; newline after body to separate from next body
1249 (newline-and-indent)
1250 (indent-region begin (point))
1252 (back-to-indentation); before 'null;'
1255 (defun ada-wisi-scan-paramlist (begin end)
1256 "For `ada-scan-paramlist'."
1257 (wisi-validate-cache end)
1277 (let ((token-text (wisi-forward-token)))
1278 (setq token (nth 0 token-text))
1279 (setq text (nth 1 token-text)))
1281 ((equal token 'COMMA) nil);; multiple identifiers
1283 ((equal token 'COLON)
1284 ;; identifiers done. find type-begin; there may be no mode
1285 (skip-syntax-forward " ")
1286 (setq type-begin (point))
1288 (while (member (car (wisi-forward-token)) '(IN OUT NOT NULL ACCESS CONSTANT PROTECTED))
1289 (skip-syntax-forward " ")
1290 (setq type-begin (point)))))
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))
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))
1308 ((member token '(SEMICOLON RIGHT_PAREN))
1309 (if (equal token 'RIGHT_PAREN)
1313 (when (not type-end) (setq type-end (1- (point))))
1314 (when default-begin (setq default (buffer-substring-no-properties default-begin (1- (point)))))
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)))))
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
1326 (add-to-list 'paramlist param)
1327 (setq paramlist (list param)))
1328 (setq identifiers nil
1342 (when (not type-begin)
1344 (add-to-list 'identifiers text)
1345 (setq identifiers (list text)))))
1349 (defun ada-wisi-which-function-1 (keyword add-body)
1350 "used in `ada-wisi-which-function'."
1353 (cache (wisi-forward-find-class 'name (point-max))))
1355 (setq result (wisi-cache-text cache))
1357 (when (not ff-function-name)
1358 (setq ff-function-name
1361 (when add-body "\\s-+body")
1367 (defun ada-wisi-which-function ()
1368 "For `ada-which-function'."
1369 (wisi-validate-cache (point))
1372 (cache (ada-wisi-goto-declaration-start)))
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))))
1384 ;; add or delete 'body' as needed
1385 (cl-ecase (wisi-cache-nonterm cache)
1387 (setq result (ada-wisi-which-function-1 "package" nil)))
1389 ((package_declaration
1390 generic_package_declaration) ;; after 'generic'
1391 (setq result (ada-wisi-which-function-1 "package" t)))
1394 (setq result (ada-wisi-which-function-1 "protected" nil)))
1396 ((protected_type_declaration single_protected_declaration)
1397 (setq result (ada-wisi-which-function-1 "protected" t)))
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
1407 (setq result (ada-wisi-which-function-1
1408 (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
1411 (task_type_declaration
1412 (setq result (ada-wisi-which-function-1 "task" t)))
1418 (defun ada-wisi-debug-keys ()
1419 "Add debug key definitions to `ada-mode-map'."
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)
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
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)
1440 (set (make-local-variable 'comment-indent-function) 'wisi-comment-indent)
1442 (add-hook 'hack-local-variables-hook 'ada-wisi-post-local-vars nil t)
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 ...;'
1454 "return[ \t]+access[ \t]+constant\\|"
1455 "return[ \t]+access\\|"
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)))))
1470 (when global-font-lock-mode
1471 ;; ensure the modified keywords are applied
1472 (font-lock-refresh-defaults))
1475 (add-hook 'ada-mode-hook 'ada-wisi-setup)
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)
1492 (provide 'ada-indent-engine)