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
56 (defun ada-wisi-current-indentation ()
57 "Return indentation appropriate for point on current line:
58 if not in paren, beginning of line
59 if in paren, pos following paren."
60 (if (not (ada-in-paren-p))
65 (let ((line (line-number-at-pos)))
66 (ada-goto-open-paren 1)
67 (when (= line (line-number-at-pos))
74 (defun ada-wisi-indent-cache (offset cache)
75 "Return indentation of OFFSET plus indentation of line containing point. Point must be at CACHE."
76 (let ((indent (current-indentation)))
80 ((eq 'LEFT_PAREN (wisi-cache-token cache))
81 ;; test/ada_mode-long_paren.adb
85 ;; (RX_Torque_Subaddress |
88 ;; test/ada_mode-parens.adb
92 ;; indenting '(local_6)'; 'offset' = ada-indent - 1
93 (+ (current-column) 1 offset))
96 (let ((containing (wisi-goto-containing-paren cache)))
98 ;; test/ada_mode-conditional_expressions.adb
99 ;; K2 : Integer := (if J > 42
101 ;; indenting 'then'; offset = 0
103 ;; L1 : Integer := (case J is
107 ;; C_S_Controls : constant
111 ;; 1 => -- Used to be aligned on "CSCL_Type'"
112 ;; -- aligned with previous comment.
113 ;; IO_CPU_Control_State_S_Pkg.CPU2_Fault_Status_Type'
114 ;; (Unused2 => 10, -- Used to be aligned on "1 =>"
115 ;; indenting '(Unused2'
116 (+ (current-column) offset)))))
118 ;; all other structures
120 ;; current cache may be preceded by something on same
121 ;; line. Handle common cases nicely.
124 (not (= (current-column) indent))
125 (eq 'EQUAL_GREATER (wisi-cache-token cache))))
127 (eq 'WHEN (wisi-cache-token cache))
128 (not (eq 'exit_statement (wisi-cache-nonterm cache))))
129 (setq offset (+ offset ada-indent-when)))
130 (setq cache (wisi-goto-containing cache))
131 (setq indent (current-indentation)))
135 ;; test/ada_mode-opentoken.ads
136 ;; private package GDS.Commands.Add_Statement is
137 ;; type Instance is new Nonterminal.Instance with null record;
140 ((eq 'label_opt (wisi-cache-token cache))
141 (+ indent (- ada-indent-label) offset))
144 ;; test/ada_mode-generic_instantiation.ads
145 ;; function Function_1 is new Instance.Generic_Function
146 ;; (Param_Type => Integer,
148 ;; test/ada_mode-nested_packages.adb
149 ;; function Create (Model : in Integer;
150 ;; Context : in String) return String is
152 ;; Cache : array (1 .. 10) of Boolean := (True, False, others => False);
157 (defun ada-wisi-indent-containing (offset cache &optional before)
158 "Return indentation of OFFSET plus indentation of token containing CACHE.
159 BEFORE should be t when called from ada-wisi-before-cache, nil otherwise."
162 ((markerp (wisi-cache-containing cache))
163 (ada-wisi-indent-cache offset (wisi-goto-containing cache)))
168 (ada-goto-open-paren 1)
169 (+ (current-column) offset))
172 ;; at outermost containing statement. If called from
173 ;; ada-wisi-before-cache, we want to ignore OFFSET (indenting
174 ;; 'package' in a package spec). If called from
175 ;; ada-wisi-after-cache, we want to include offset (indenting
176 ;; first declaration in the package).
177 (if before 0 offset))
181 (defun ada-wisi-indent-list-break (cache prev-token)
182 "Return indentation for a token contained by CACHE, which must be a list-break.
183 point must be on CACHE. PREV-TOKEN is the token before the one being indented."
184 (let ((break-point (point))
185 (containing (wisi-goto-containing cache)))
186 (cl-ecase (wisi-cache-token containing)
188 (if (equal break-point (cadr prev-token))
189 ;; we are indenting the first token after the list-break; not hanging.
192 ;; Append_To (Formals,
193 ;; Make_Parameter_Specification (Loc,
194 ;; indenting 'Make_...'
196 ;; test/ada_mode-generic_instantiation.ads
197 ;; function Function_1 is new Instance.Generic_Function
198 ;; (Param_Type => Integer,
199 ;; Result_Type => Boolean,
201 ;; indenting 'Result_Type'
202 (+ (current-column) 1)
205 ;; test/ada_mode-parens.adb
212 (+ (current-column) 1 ada-indent-broken)))
215 ;; test/ada_mode-conditional_expressions.adb
216 ;; L1 : Integer := (case J is
218 ;; -- comment aligned with 'when'
219 ;; indenting '-- comment'
220 (wisi-indent-paren (+ 1 ada-indent-when)))
223 (cl-ecase (wisi-cache-nonterm containing)
225 ;; test/ada_mode-nominal-child.ads
226 ;; (Default_Parent with
227 ;; Child_Element_1 => 10,
228 ;; Child_Element_2 => 12.0,
229 ;; indenting 'Child_Element_2'
230 (wisi-indent-paren 1))
232 (aspect_specification_opt
234 ;; type Vector is tagged private
236 ;; Constant_Indexing => Constant_Reference,
237 ;; Variable_Indexing => Reference,
238 ;; indenting 'Variable_Indexing'
239 (+ (current-indentation) ada-indent-broken))
244 (defun ada-wisi-before-cache ()
245 "Point is at indentation, before a cached token. Return new indentation for point."
246 (let ((pos-0 (point))
247 (cache (wisi-get-cache (point)))
248 (prev-token (save-excursion (wisi-backward-token)))
251 (cl-ecase (wisi-cache-class cache)
253 (cl-case (wisi-cache-token cache)
254 (IS ;; subprogram body
255 (ada-wisi-indent-containing 0 cache t))
258 ;; test/ada_mode-nominal.ads; ada-indent-record-rel-type = 3
259 ;; type Private_Type_2 is abstract tagged limited
261 ;; indenting 'record'
263 ;; type Limited_Derived_Type_1d is
264 ;; abstract limited new Private_Type_1 with
266 ;; indenting 'record'
268 ;; for Record_Type_1 use
270 ;; indenting 'record'
271 (let ((containing (wisi-goto-containing cache)))
272 (while (not (memq (wisi-cache-token containing) '(FOR TYPE)))
273 (setq containing (wisi-goto-containing containing)))
274 (+ (current-column) ada-indent-record-rel-type)))
277 (ada-wisi-indent-containing ada-indent cache t))))
280 (cl-case (wisi-cache-nonterm cache)
283 (wisi-goto-containing cache);; now on 'record'
284 (current-indentation)))
287 (ada-wisi-indent-containing 0 cache t))
291 (cl-case (wisi-cache-token cache)
293 (ada-wisi-indent-containing ada-indent-when cache t))
296 (ada-wisi-indent-containing 0 cache t))
299 (close-paren (wisi-indent-paren 0))
302 ;; defer to after-cache)
307 ((let ((temp (save-excursion (wisi-goto-containing cache))))
309 (memq (wisi-cache-nonterm temp) '(subprogram_body subprogram_declaration))))
310 ;; test/ada_mode-nominal.ads
314 ;; Procedure_1c (Item : in out Parent_Type_1);
315 ;; indenting 'Procedure_1c'
317 ;; not overriding function
318 ;; Function_2e (Param : in Parent_Type_1) return Float;
319 ;; indenting 'Function_2e'
320 (ada-wisi-indent-containing ada-indent-broken cache t))
323 ;; defer to ada-wisi-after-cache, for consistency
328 ;; defer to ada-wisi-after-cache, for consistency
332 (let* ((containing (wisi-goto-containing cache))
333 (containing-pos (point)))
334 (cl-case (wisi-cache-token containing)
336 ;; test/ada_mode-parens.adb
337 ;; A : Matrix_Type :=
340 ;; indenting (4; containing is '),' ; 0
342 ;; test/ada_mode-parens.adb
343 ;; Local_14 : Local_14_Type :=
347 ;; indenting ("4"; contaning is '3",' ; ada-indent-broken
349 (ada-wisi-indent-containing
350 (if (= (nth 1 prev-token) containing-pos) 0 ada-indent-broken)
354 (setq containing (wisi-goto-containing containing))
355 (cl-ecase (wisi-cache-token containing)
357 ;; test/ada_mode-long_paren.adb
361 ;; (RX_Torque_Subaddress |
362 ;; indenting (RX_Torque
363 (ada-wisi-indent-containing ada-indent-broken containing t))
365 ;; test/ada_mode-parens.adb
368 ;; indenting '(1 => 12'; containing is '=>'
369 (ada-wisi-indent-cache (1- ada-indent) containing))
371 ;; test/ada_mode-conditional_expressions.adb
374 ;; indenting '(if'; containing is '=>'
375 (+ (current-column) -1 ada-indent))
378 ;; function Wuff return Boolean with Pre =>
379 ;; (for all x in U =>
380 ;; indenting '(for'; containing is '=>', 'with', 'function'
381 (ada-wisi-indent-cache (1- ada-indent) containing))
384 ((FUNCTION PROCEDURE)
385 ;; test/ada_mode-nominal.adb
386 ;; function Function_Access_11
387 ;; (A_Param : in Float)
388 ;; -- EMACSCMD:(test-face "function" font-lock-keyword-face)
389 ;; return access function
390 ;; (A_Param : in Float)
392 ;; Standard.Float -- Ada mode 4.01, GPS do this differently
393 ;; indenting second '(A_Param)
394 (+ (current-indentation) -1 ada-indent))
397 ;; test/ada_mode-parens.adb
403 (+ (current-column) 1 ada-indent-broken))
406 ;; test/ada_mode-nominal.adb
408 ;; when Local_1 = 0 and not
410 ;; indenting (Local_2
413 ;; (X : Integer) when Local_1 = 0 and not
415 (+ (ada-wisi-current-indentation) ada-indent-broken))
417 ((IDENTIFIER selected_component name)
423 ;; test/ada_mode-parens.adb
431 ;; test/ada_mode-parens.adb
432 ;; Local_11 : Local_11_Type := Local_11_Type'
438 ;; test/ada_mode-parens.adb
439 ;; Local_12 : Local_11_Type
440 ;; := Local_11_Type'(A => Integer
443 (+ (ada-wisi-current-indentation) ada-indent-broken))
447 ((memq (wisi-cache-class containing) '(block-start statement-start))
448 ;; test/ada_mode-nominal.adb
452 (ada-wisi-indent-cache ada-indent-broken containing))
455 ;; Open paren in an expression.
457 ;; test/ada_mode-conditional_expressions.adb
459 ;; (case J is when 42 => -1, when Integer'First .. 41 => 0, when others => 1);
461 (ada-wisi-indent-containing ada-indent-broken containing t))
465 (return-1;; parameter list
466 (let ((return-pos (point)))
467 (wisi-goto-containing cache nil) ;; matching 'function'
469 ((<= ada-indent-return 0)
470 ;; indent relative to "("
471 (wisi-forward-find-class 'open-paren return-pos)
472 (+ (current-column) (- ada-indent-return)))
475 (+ (current-column) ada-indent-return))
478 (return-2;; no parameter list
479 (wisi-goto-containing cache nil) ;; matching 'function'
480 (+ (current-column) ada-indent-broken))
483 (ada-wisi-indent-containing ada-indent-broken cache t))
487 (let ((containing (wisi-goto-containing cache nil)))
488 (while (not (wisi-cache-nonterm containing))
489 (setq containing (wisi-goto-containing containing)))
492 ;; cases to defer to after-cache
494 (eq (wisi-cache-nonterm cache) 'qualified_expression)
495 ;; test/ada_mode-parens.adb Local_13 Integer'
496 (not (eq (wisi-cache-token containing) 'COLON_EQUAL)))
497 ;; _not_ test/indent.ads CSCL_Type'
502 (cl-case (wisi-cache-token cache)
504 (+ (current-column) ada-indent-broken))
508 ;; elsif Current_Argument < CL.Argument_Count then
509 (ada-wisi-indent-cache 0 containing))
512 (cl-ecase (wisi-cache-nonterm containing)
513 ((generic_renaming_declaration subprogram_renaming_declaration)
514 (wisi-forward-find-token '(FUNCTION PROCEDURE) pos-0)
515 (let ((pos-subprogram (point))
517 ;; this is wrong for one return access
518 ;; function case: overriding function Foo
519 ;; return access Bar (...) renames ...;
520 (wisi-forward-find-token 'LEFT_PAREN pos-0 t)))
522 (if (<= ada-indent-renames 0)
523 ;; indent relative to paren
524 (+ (current-column) (- ada-indent-renames))
525 ;; else relative to line containing keyword
526 (goto-char pos-subprogram)
527 (+ (current-indentation) ada-indent-renames))
530 (goto-char pos-subprogram)
531 (+ (current-indentation) ada-indent-broken))
534 (object_renaming_declaration
535 (+ (current-indentation) ada-indent-broken))
539 (cl-ecase (wisi-cache-nonterm containing)
541 ;; test/ada_mode-nominal-child.adb
542 ;; return (Parent_Type_1
543 ;; with 1, 0.0, False);
544 ;; indenting 'with'; containing is '('
545 (+ (current-column) 1))
547 (component_declaration
548 ;; test/ada_mode-nominal.ads Record_Type_3 ':'
549 (+ (current-column) ada-indent-broken))
552 ;; test/ada_mode-nominal.adb
555 ;; when Local_1 = 0 and not
556 ;; indenting 'when'; containing is 'entry'
557 (+ (current-column) ada-indent-broken))
559 (formal_package_declaration
560 ;; test/ada_mode-generic_package.ads
561 ;; with package A_Package_7 is
562 ;; new Ada.Text_IO.Integer_IO (Num => Formal_Signed_Integer_Type);
563 ;; indenting 'new'; containing is 'with'
564 (+ (current-column) ada-indent-broken))
566 ((full_type_declaration subtype_declaration)
567 (while (not (memq (wisi-cache-token containing) '(TYPE SUBTYPE)))
568 (setq containing (wisi-goto-containing containing)))
571 ((eq (wisi-cache-token cache) 'WITH)
572 (let ((type-col (current-column))
573 (null_private (save-excursion (wisi-goto-end-1 cache)
574 (eq 'WITH (wisi-cache-token (wisi-backward-cache))))))
576 ((eq 'aspect_specification_opt (wisi-cache-nonterm cache))
578 ;; subtype Integer_String is String
579 ;; with Dynamic_Predicate => Integer'Value (Integer_String) in Integer
584 ;; 'with null record;' or 'with private;'
585 ;; test/ada_mode-nominal.ads
586 ;; type Limited_Derived_Type_3 is abstract limited new Private_Type_1
588 ;; indenting 'with'; containing is 'is'
589 (+ type-col ada-indent-broken))
592 ;; test/ada_mode-nominal.ads
593 ;; type Unconstrained_Array_Type_3 is array (Integer range <>, Standard.Character range <>)
594 ;; of Object_Access_Type_1;
595 ;; indenting 'of'; containing is 'is'
597 ;; type Object_Access_Type_7
598 ;; is access all Integer;
599 ;; indenting 'is'; containing is 'type'
600 (+ type-col ada-indent-record-rel-type)))))
603 ;; test/ada_mode-nominal.ads
604 ;; type Limited_Derived_Type_2a is abstract limited new Private_Type_1
606 ;; indenting 'with record'
608 ;; test/access_in_record.ads
610 ;; is new Ada.Streams.Root_Stream_Type with record
612 ;; test/adacore_9717_001.ads A_Long_Name
613 ;; subtype A_Long_Name
614 ;; is Ada.Text_Io.Count;
616 (+ (current-column) ada-indent-broken))
619 (generic_instantiation
620 ;; test/ada_mode-generic_instantiation.ads
621 ;; procedure Procedure_7 is
622 ;; new Instance.Generic_Procedure (Integer, Function_1);
624 (+ (current-column) ada-indent-broken))
626 (generic_renaming_declaration
627 ;; indenting keyword following 'generic'
631 (cl-ecase (wisi-cache-token containing)
633 ;; test/ada_mode-nominal.ads
634 ;; Anon_Array_3 : array (1 .. 10)
637 (+ (current-indentation) ada-indent-broken))
641 ;; C_S_Controls : constant
644 ;; indenting 'CSCL_Type'
645 (+ (current-indentation) ada-indent-broken))
648 ;; test/ada_mode-nominal.adb
649 ;; Local_2 : constant Float
651 (+ (current-indentation) ada-indent-broken))
654 (private_extension_declaration
655 ;; test/ada_mode-nominal.ads
656 ;; type Limited_Derived_Type_3 is abstract limited
657 ;; new Private_Type_1 with private;
658 (+ (current-indentation) ada-indent-broken))
660 (private_type_declaration
662 ;; type Vector is tagged private
665 (current-indentation))
667 (qualified_expression
668 ;; test/ada_mode-nominal-child.ads
669 ;; Child_Obj_5 : constant Child_Type_1 :=
671 ;; (Parent_Element_1 => 1,
672 (ada-wisi-indent-cache ada-indent-broken containing))
675 (cl-case (wisi-cache-token containing)
677 (- (current-column) ada-indent-label))
680 ;; test/ada_mode-nominal.adb
686 (ada-wisi-indent-cache ada-indent-broken cache))
689 ((subprogram_body subprogram_declaration subprogram_specification null_procedure_declaration)
690 (cl-ecase (wisi-cache-token cache)
692 ;; test/ada_mode-nominal.ads
693 ;; procedure Procedure_1d
694 ;; (Item : in out Parent_Type_1;
695 ;; Item_1 : in Character;
696 ;; Item_2 : out Character)
699 (+ (current-column) ada-indent-broken))
702 ;; indenting 'overriding' following 'not'
705 ((PROCEDURE FUNCTION)
706 ;; indenting 'procedure' or 'function following 'overriding'
710 ;; indenting aspect specification on subprogram declaration
712 ;; procedure Foo (X : Integer;
714 ;; with Pre => X > 10 and
720 )))) ;; end statement-other
724 ((eq 'label_opt (wisi-cache-token cache))
725 (ada-wisi-indent-containing (+ ada-indent-label ada-indent) cache t))
728 (let ((containing-cache (wisi-get-containing-cache cache)))
729 (if (not containing-cache)
733 (cl-case (wisi-cache-class containing-cache)
734 ((block-start block-middle)
735 (wisi-goto-containing cache)
736 (cl-case (wisi-cache-nonterm containing-cache)
738 (+ (current-indentation) ada-indent))
741 (ada-wisi-indent-cache ada-indent containing-cache))
745 (ada-wisi-indent-list-break cache prev-token))
748 ;; defer to ada-wisi-after-cache
755 (defun ada-wisi-after-cache ()
756 "Point is at indentation, not before a cached token. Find previous
757 cached token, return new indentation for point."
759 (let ((start (point))
760 (prev-token (save-excursion (wisi-backward-token)))
761 (cache (wisi-backward-cache)))
768 (while (memq (wisi-cache-class cache) '(keyword name name-paren type))
769 ;; not useful for indenting
770 (setq cache (wisi-backward-cache)))
772 (cl-ecase (wisi-cache-class cache)
774 ;; indenting block/subprogram name after 'end'
775 (wisi-indent-current ada-indent-broken))
778 (cl-case (wisi-cache-token cache)
780 (cl-case (wisi-cache-nonterm cache)
782 ;; between 'case .. is' and first 'when'; most likely a comment
783 (ada-wisi-indent-containing 0 cache t))
786 (+ (ada-wisi-indent-containing ada-indent cache t)))
791 ;; test/ada_mode-conditional_expressions.adb
792 ;; K3 : Integer := (if
800 (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
801 ((statement if_statement elsif_statement_item) ada-indent)
802 ((if_expression elsif_expression_item) ada-indent-broken))))
803 (ada-wisi-indent-containing indent cache t)))
806 ;; between 'when' and '=>'
807 (+ (current-column) ada-indent-broken))
810 ;; block-middle keyword may not be on separate line:
811 ;; function Create (Model : in Integer;
812 ;; Context : in String) return String is
813 (ada-wisi-indent-containing ada-indent cache nil))
817 (cl-case (wisi-cache-nonterm cache)
819 ;; between 'when' and '=>'
820 (+ (current-column) ada-indent-broken))
823 (ada-wisi-indent-containing ada-indent-broken cache nil))
826 (ada-wisi-indent-containing (+ ada-indent-when ada-indent-broken) cache nil))
828 (t ;; other; normal block statement
829 (ada-wisi-indent-cache ada-indent cache))
833 ;; actual_parameter_part: test/ada_mode-nominal.adb
835 ;; Foo (Bar) + -- multi-line expression that happens to have a cache at a line start
837 ;; indenting '12'; don't indent relative to containing function name
839 ;; attribute_designator: test/ada_mode-nominal.adb
840 ;; raise Constraint_Error with Count'Image (Line (File)) &
842 ;; indenting '"foo"'; relative to raise
844 ;; test/ada_mode-slices.adb
845 ;; Put_Line(Day'Image(D1) & " - " & Day'Image(D2) & " = " &
846 ;; Integer'Image(N));
847 ;; indenting 'Integer'
848 (when (memq (wisi-cache-nonterm cache)
849 '(actual_parameter_part attribute_designator))
850 (setq cache (wisi-goto-containing cache)))
851 (ada-wisi-indent-containing ada-indent-broken cache nil))
854 (ada-wisi-indent-list-break cache prev-token))
857 ;; 1) A parenthesized expression, or the first item in an aggregate:
864 ;; we are indenting 'bar'
866 ;; 2) A parenthesized expression, or the first item in an
867 ;; aggregate, and there is whitespace between
868 ;; ( and the first token:
870 ;; test/ada_mode-parens.adb
871 ;; Local_9 : String := (
874 ;; 3) A parenthesized expression, or the first item in an
875 ;; aggregate, and there is a comment between
876 ;; ( and the first token:
878 ;; test/ada_mode-nominal.adb
881 ;; -- a comment between paren and first association
884 ;; test/ada_mode-parens.adb
887 ;; indenting 'Integer'
888 (let ((paren-column (current-column))
889 (start-is-comment (save-excursion (goto-char start) (looking-at comment-start-skip))))
890 (wisi-forward-token); point is now after paren
892 (skip-syntax-forward " >"); point is now on comment
893 (forward-comment (point-max)); point is now on first token
895 (if (= (point) start)
899 (+ paren-column 1 ada-indent-broken))))
902 ;; test/ada_mode-nominal.adb
903 ;; function Function_Access_1
904 ;; (A_Param : in Float)
907 ;; indenting 'Standard.Float'
909 ;; test/ada_mode-expression_functions.ads
910 ;; function Square (A : in Float) return Float
914 ;; test/ada_mode-nominal.ads
915 ;; function Function_2g
916 ;; (Param : in Private_Type_1)
920 (back-to-indentation)
921 (+ (current-column) ada-indent-broken))
924 (ada-wisi-indent-containing 0 cache nil))
927 (cl-ecase (wisi-cache-token cache)
933 ;; -- 'abort' indented with ada-indent-broken, since this is part
935 (ada-wisi-indent-containing ada-indent cache))
937 ;; test/subdir/ada_mode-separate_task_body.adb
939 ;; Local_3 : constant Float :=
942 ;; test/ada_mode-nominal.ads
943 ;; type Record_Type_3 (Discriminant_1 : access Integer) is tagged record
944 ;; Component_1 : Integer; -- end 2
947 ;; indenting 'Integer'; containing is ';'
948 (ada-wisi-indent-cache ada-indent-broken cache))
951 (cl-ecase (wisi-cache-nonterm cache)
953 (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
955 ;; test/with_use1.adb
956 (ada-wisi-indent-containing ada-indent-use cache))
959 ;; test/ada_mode-nominal.ads
960 ;; limited private with Ada.Strings.Bounded,
961 ;; --EMACSCMD:(test-face "Ada.Containers" 'default)
964 ;; test/with_use1.adb
965 (ada-wisi-indent-containing ada-indent-with cache))
971 ;; elsif Index_Switches + Max_Length <= Switches'Last
972 ;; and then Switches (Index_Switches + Max_Length) = '?'
973 (ada-wisi-indent-cache ada-indent-broken cache))
976 (let ((cache-col (current-column))
978 (line-end-pos (line-end-position))
979 (containing (wisi-goto-containing cache nil)))
980 (while (eq (wisi-cache-nonterm containing) 'association_list)
981 (setq containing (wisi-goto-containing containing nil)))
983 (cl-ecase (wisi-cache-nonterm containing)
984 ((actual_parameter_part aggregate)
985 ;; ada_mode-generic_package.ads
986 ;; with package A_Package_2 is new Ada.Text_IO.Integer_IO (Num =>
987 ;; Formal_Signed_Integer_Type);
988 ;; indenting 'Formal_Signed_...', point on '(Num'
990 ;; test/ada_mode-parens.adb
995 ;; indenting '1,' or '1 +'; point on '(1'
997 ;; test/ada_mode-parens.adb
998 ;; Local_13 : Local_11_Type
1001 ;; indenting 'Integer'; point on '(Integer'
1002 (+ (current-column) 1 ada-indent-broken))
1004 (aspect_specification_opt
1006 ;; with Pre => X > 10 and
1011 ;; indenting 'X < 50' or 'Y >= X'; cache is '=>', point is on '=>'
1012 ;; or indenting 'Post =>'; cache is ',', point is on 'with'
1013 (cl-ecase (wisi-cache-token cache)
1015 (+ (current-indentation) ada-indent-broken))
1018 (if (= (+ 2 cache-pos) line-end-pos)
1022 (goto-char cache-pos)
1023 (+ (current-indentation) ada-indent-broken))
1024 ;; with Pre => X > 10 and
1030 (cl-ecase (save-excursion (wisi-cache-token (wisi-goto-containing cache nil)))
1032 (ada-wisi-indent-containing (* 2 ada-indent-broken) cache))
1035 ((case_expression_alternative case_statement_alternative exception_handler)
1036 ;; containing is 'when'
1037 (+ (current-column) ada-indent))
1039 (generic_renaming_declaration
1040 ;; not indenting keyword following 'generic'
1041 (+ (current-column) ada-indent-broken))
1044 ;; test/ada_mode-quantified_expressions.adb
1045 ;; if (for some J in 1 .. 10 =>
1047 (ada-wisi-indent-containing ada-indent-broken cache))
1051 ;; test/ada_mode-nominal.adb
1055 ;; indenting 'accept'; point is on 'when'
1056 (+ (current-column) ada-indent))
1059 ;; test/generic_param.adb
1060 ;; case Item_Type is
1061 ;; when Fix | Airport =>
1064 (+ (current-column) ada-indent))
1069 (setq cache (wisi-goto-containing cache))
1070 (cl-ecase (wisi-cache-nonterm cache)
1071 (full_type_declaration
1072 ;; ada_mode/nominal.ads
1073 ;; type Limited_Derived_Type_1a is abstract limited new
1074 ;; Private_Type_1 with record
1075 ;; Component_1 : Integer;
1076 ;; indenting 'Private_Type_1'; look for 'record'
1077 (let ((type-column (current-column)))
1079 (if (wisi-forward-find-token 'RECORD (line-end-position) t)
1080 ;; 'record' on line being indented
1081 (+ type-column ada-indent-record-rel-type)
1082 ;; 'record' on later line
1083 (+ type-column ada-indent-broken))))
1085 ((formal_type_declaration
1086 ;; test/ada_mode-generic_package.ads
1087 ;; type Synchronized_Formal_Derived_Type is abstract synchronized new Formal_Private_Type and Interface_Type
1090 subtype_declaration)
1091 ;; test/ada_mode-nominal.ads
1092 ;; subtype Subtype_2 is Signed_Integer_Type range 10 ..
1095 (+ (current-column) ada-indent-broken))
1097 (null_procedure_declaration
1098 ;; ada_mode-nominal.ads
1099 ;; procedure Procedure_3b is
1102 (+ (current-column) ada-indent-broken))
1108 ;; C_S_Controls : constant
1113 (+ (current-column) 1))
1116 ;; ada_mode-nominal.ads
1117 ;; type Limited_Derived_Type_2 is abstract limited new Private_Type_1 with
1120 ;; test/ada_mode-generic_instantiation.ads
1121 ;; procedure Procedure_6 is new
1122 ;; Instance.Generic_Procedure (Integer, Function_1);
1123 ;; indenting 'Instance'; containing is 'new'
1124 (ada-wisi-indent-containing ada-indent-broken cache))
1127 ;; ada_mode-nominal.ads
1128 ;; Anon_Array_2 : array (1 .. 10) of
1130 (ada-wisi-indent-containing ada-indent-broken cache))
1133 ;; test/ada_mode-parens.adb
1136 (ada-wisi-indent-containing ada-indent-broken cache))
1139 (cl-case (wisi-cache-nonterm cache)
1141 ;; test/ada_mode-nominal-child.ads
1142 ;; (Default_Parent with
1144 ;; indenting '10'; containing is '('
1145 (ada-wisi-indent-containing 0 cache nil))
1147 (aspect_specification_opt
1149 ;; type Vector is tagged private
1151 ;; Constant_Indexing => Constant_Reference,
1152 ;; indenting 'Constant_Indexing'; point is on 'with'
1153 (+ (current-indentation) ada-indent-broken))
1156 ;; otherwise just hanging
1157 ((ACCEPT FUNCTION PROCEDURE RENAMES)
1158 (back-to-indentation)
1159 (+ (current-column) ada-indent-broken))
1164 (cl-case (wisi-cache-token cache)
1165 (WITH ;; with_clause
1166 (+ (current-column) ada-indent-with))
1169 ;; comment after label
1170 (+ (current-column) (- ada-indent-label)))
1173 ;; procedure Procedure_8
1174 ;; is new Instance.Generic_Procedure (Integer, Function_1);
1175 ;; indenting 'is'; hanging
1177 ;; test/ada_mode-conditional_expressions.adb
1178 ;; K3 : Integer := (if
1185 (ada-wisi-indent-cache ada-indent-broken cache))
1190 (defun ada-wisi-comment ()
1191 "Compute indentation of a comment. For `wisi-indent-calculate-functions'."
1192 ;; We know we are at the first token on a line. We check for comment
1193 ;; syntax, not comment-start, to accomodate gnatprep, skeleton
1194 ;; placeholders, etc.
1195 (when (and (not (= (point) (point-max))) ;; no char after EOB!
1196 (= 11 (syntax-class (syntax-after (point)))))
1198 ;; We are at a comment; indent to previous code or comment.
1200 ((and ada-indent-comment-col-0
1201 (= 0 (current-column)))
1205 (save-excursion (forward-line -1) (looking-at "\\s *$"))
1206 (save-excursion (forward-comment -1)(not (looking-at comment-start))))
1207 ;; comment is after a blank line or code; indent as if code
1209 ;; ada-wisi-before-cache will find the keyword _after_ the
1210 ;; comment, which could be a block-middle or block-end, and that
1211 ;; would align the comment with the block-middle, which is wrong. So
1212 ;; we only call ada-wisi-after-cache.
1214 ;; FIXME: need option to match gnat style check; change indentation to match (ie mod 3)
1215 (ada-wisi-after-cache))
1218 ;; comment is after a comment
1219 (forward-comment -1)
1223 (defun ada-wisi-post-parse-fail ()
1224 "For `wisi-post-parse-fail-hook'."
1226 (let ((start-cache (wisi-goto-start (or (wisi-get-cache (point)) (wisi-backward-cache)))))
1228 ;; nil when in a comment at point-min
1229 (indent-region (point) (wisi-cache-end start-cache)))
1231 (back-to-indentation))
1233 ;;;; ada-mode functions (alphabetical)
1235 (defun ada-wisi-declarative-region-start-p (cache)
1236 "Return t if cache is a keyword starting a declarative region."
1237 (cl-case (wisi-cache-token cache)
1240 (memq (wisi-cache-class cache) '(block-start block-middle)))
1244 (defun ada-wisi-context-clause ()
1245 "For `ada-fix-context-clause'."
1246 (wisi-validate-cache (point-max))
1248 (goto-char (point-min))
1254 (setq cache (wisi-forward-cache))
1255 (cl-case (wisi-cache-nonterm cache)
1256 (pragma (wisi-goto-end-1 cache))
1257 (use_clause (wisi-goto-end-1 cache))
1260 (setq begin (point-at-bol)))
1261 (wisi-goto-end-1 cache))
1263 ;; start of compilation unit
1264 (setq end (point-at-bol))
1271 (defun ada-wisi-on-context-clause ()
1272 "For `ada-on-context-clause'."
1275 (and (wisi-goto-statement-start)
1276 (memq (wisi-cache-nonterm (wisi-goto-statement-start)) '(use_clause with_clause)))))
1278 (defun ada-wisi-goto-subunit-name ()
1279 "For `ada-goto-subunit-name'."
1280 (wisi-validate-cache (point-max))
1281 (if (not (> wisi-cache-max (point)))
1283 (message "parse failed; can't goto subunit name")
1290 ;; move to top declaration
1291 (goto-char (point-min))
1292 (setq cache (or (wisi-get-cache (point))
1293 (wisi-forward-cache)))
1295 (cl-case (wisi-cache-nonterm cache)
1296 ((pragma use_clause with_clause)
1297 (wisi-goto-end-1 cache)
1298 (setq cache (wisi-forward-cache)))
1300 ;; start of compilation unit
1303 (when (eq (wisi-cache-nonterm cache) 'subunit)
1304 (wisi-forward-find-class 'name (point-max)) ;; parent name
1305 (wisi-forward-token)
1306 (wisi-forward-find-class 'name (point-max)) ;; subunit name
1307 (setq name-pos (point)))
1310 (goto-char name-pos))
1313 (defun ada-wisi-goto-declaration-start ()
1314 "For `ada-goto-declaration-start', which see.
1315 Also return cache at start."
1316 (wisi-validate-cache (point))
1317 (unless (> wisi-cache-max (point))
1318 (error "parse failed; can't goto declarative-region-start"))
1320 (let ((cache (wisi-get-cache (point)))
1323 (setq cache (wisi-backward-cache)))
1324 ;; cache is null at bob
1329 (cl-case (wisi-cache-nonterm cache)
1330 ((generic_package_declaration generic_subprogram_declaration)
1331 (eq (wisi-cache-token cache) 'GENERIC))
1333 ((package_body package_declaration)
1334 (eq (wisi-cache-token cache) 'PACKAGE))
1336 ((protected_body protected_type_declaration single_protected_declaration)
1337 (eq (wisi-cache-token cache) 'PROTECTED))
1339 ((subprogram_body subprogram_declaration null_procedure_declaration)
1340 (memq (wisi-cache-token cache) '(NOT OVERRIDING FUNCTION PROCEDURE)))
1342 (task_type_declaration
1343 (eq (wisi-cache-token cache) 'TASK))
1347 (setq cache (wisi-goto-containing cache nil))))
1352 (defun ada-wisi-goto-declaration-end ()
1353 "For `ada-goto-declaration-end', which see."
1354 ;; first goto-declaration-start, so we get the right end, not just
1355 ;; the current statement end.
1356 (wisi-goto-end-1 (ada-wisi-goto-declaration-start)))
1358 (defun ada-wisi-goto-declarative-region-start ()
1359 "For `ada-goto-declarative-region-start', which see."
1360 (wisi-validate-cache (point))
1361 (unless (> wisi-cache-max (point))
1362 (error "parse failed; can't goto declarative-region-start"))
1368 (wisi-get-cache (point))
1369 ;; we use forward-cache here, to handle the case where point is after a subprogram declaration:
1372 ;; function ... is ... end;
1374 ;; function ... is ... end;
1375 (wisi-forward-cache))))
1377 (if (ada-wisi-declarative-region-start-p cache)
1379 (wisi-forward-token)
1381 (cl-case (wisi-cache-class cache)
1382 ((block-middle block-end)
1383 (setq cache (wisi-prev-statement-cache cache)))
1386 ;; 1) test/ada_mode-nominal.adb
1387 ;; protected body Protected_1 is -- target 2
1391 ;; 2) test/ada_mode-nominal.adb
1392 ;; function Function_Access_1
1393 ;; (A_Param <point> : in Float)
1399 ;; 3) test/ada_mode-nominal-child.adb
1400 ;; overriding <point> function Function_2c (Param : in Child_Type_1)
1402 ;; is -- target Function_2c
1407 (setq cache (wisi-goto-containing cache t))
1409 (cl-case (wisi-cache-nonterm cache)
1411 (while (not (eq 'IS (wisi-cache-token cache)))
1412 (setq cache (wisi-next-statement-cache cache))))
1414 (setq cache (wisi-goto-containing cache t)))
1417 (setq cache (wisi-goto-containing cache t)))
1419 (when first (setq first nil)))
1422 (defun ada-wisi-in-paramlist-p ()
1423 "For `ada-in-paramlist-p'."
1424 (wisi-validate-cache (point))
1425 ;; (info "(elisp)Parser State" "*syntax-ppss*")
1426 (let* ((parse-result (syntax-ppss))
1428 (and (> (nth 0 parse-result) 0)
1429 ;; cache is nil if the parse failed
1430 (setq cache (wisi-get-cache (nth 1 parse-result)))
1431 (eq 'formal_part (wisi-cache-nonterm cache)))
1434 (defun ada-wisi-make-subprogram-body ()
1435 "For `ada-make-subprogram-body'."
1436 (wisi-validate-cache (point))
1437 (when wisi-parse-failed
1438 (error "syntax parse failed; cannot create body"))
1440 (let* ((begin (point))
1441 (end (save-excursion (wisi-forward-find-class 'statement-end (point-max)) (point)))
1442 (cache (wisi-forward-find-class 'name end))
1443 (name (buffer-substring-no-properties
1445 (+ (point) (wisi-cache-last cache)))))
1448 (insert " is begin\nnull;\nend ");; legal syntax; parse does not fail
1452 ;; newline after body to separate from next body
1453 (newline-and-indent)
1454 (indent-region begin (point))
1456 (back-to-indentation); before 'null;'
1459 (defun ada-wisi-scan-paramlist (begin end)
1460 "For `ada-scan-paramlist'."
1461 (wisi-validate-cache end)
1462 (when (< wisi-cache-max end)
1463 (error "parse failed; can't scan paramlist"))
1485 (let ((token-text (wisi-forward-token)))
1486 (setq token (nth 0 token-text))
1487 (setq text (wisi-token-text token-text)))
1489 ((equal token 'COMMA) nil);; multiple identifiers
1491 ((equal token 'COLON)
1492 ;; identifiers done. find type-begin; there may be no mode
1493 (skip-syntax-forward " ")
1494 (setq type-begin (point))
1496 (while (member (car (wisi-forward-token)) '(ALIASED IN OUT NOT NULL ACCESS CONSTANT PROTECTED))
1497 (skip-syntax-forward " ")
1498 (setq type-begin (point)))))
1500 ((equal token 'ALIASED) (setq aliased-p t))
1501 ((equal token 'IN) (setq in-p t))
1502 ((equal token 'OUT) (setq out-p t))
1503 ((and (not type-end)
1504 (member token '(NOT NULL)))
1505 ;; "not", "null" could be part of the default expression
1506 (setq not-null-p t))
1507 ((equal token 'ACCESS) (setq access-p t))
1508 ((equal token 'CONSTANT) (setq constant-p t))
1509 ((equal token 'PROTECTED) (setq protected-p t))
1511 ((equal token 'COLON_EQUAL)
1512 (setq type-end (save-excursion (backward-char 2) (skip-syntax-backward " ") (point)))
1513 (skip-syntax-forward " ")
1514 (setq default-begin (point))
1515 (wisi-forward-find-token 'SEMICOLON end t))
1517 ((member token '(SEMICOLON RIGHT_PAREN))
1518 (when (not type-end)
1519 (setq type-end (save-excursion (backward-char 1) (skip-syntax-backward " ") (point))))
1521 (setq type (buffer-substring-no-properties type-begin type-end))
1524 (setq default (buffer-substring-no-properties default-begin (1- (point)))))
1526 (when (equal token 'RIGHT_PAREN)
1529 (setq param (list (reverse identifiers)
1530 aliased-p in-p out-p not-null-p access-p constant-p protected-p
1532 (cl-pushnew param paramlist :test #'equal)
1533 (setq identifiers nil
1548 (when (not type-begin)
1549 (cl-pushnew text identifiers :test #'equal)))
1553 (defun ada-wisi-which-function-1 (keyword add-body)
1554 "used in `ada-wisi-which-function'."
1557 (cache (wisi-forward-find-class 'name (point-max))))
1559 (setq result (wisi-cache-text cache))
1561 (when (not ff-function-name)
1562 (setq ff-function-name
1565 (when add-body "\\s-+body")
1571 (defun ada-wisi-which-function ()
1572 "For `ada-which-function'."
1573 (wisi-validate-cache (point))
1576 (cache (condition-case nil (ada-wisi-goto-declaration-start) (error nil))))
1578 ;; bob or failed parse
1581 (cl-case (wisi-cache-nonterm cache)
1582 ((generic_package_declaration generic_subprogram_declaration)
1583 ;; name is after next statement keyword
1584 (wisi-next-statement-cache cache)
1585 (setq cache (wisi-get-cache (point))))
1588 ;; add or delete 'body' as needed
1589 (cl-ecase (wisi-cache-nonterm cache)
1591 (setq result (ada-wisi-which-function-1 "package" nil)))
1593 ((package_declaration
1594 generic_package_declaration) ;; after 'generic'
1595 (setq result (ada-wisi-which-function-1 "package" t)))
1598 (setq result (ada-wisi-which-function-1 "protected" nil)))
1600 ((protected_type_declaration single_protected_declaration)
1601 (setq result (ada-wisi-which-function-1 "protected" t)))
1603 ((subprogram_declaration
1604 generic_subprogram_declaration ;; after 'generic'
1605 null_procedure_declaration)
1606 (setq result (ada-wisi-which-function-1
1607 (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
1608 nil))) ;; no 'body' keyword in subprogram bodies
1611 (setq result (ada-wisi-which-function-1
1612 (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
1615 (task_type_declaration
1616 (setq result (ada-wisi-which-function-1 "task" t)))
1622 (defun ada-wisi-debug-keys ()
1623 "Add debug key definitions to `ada-mode-map'."
1625 (define-key ada-mode-map "\M-e" 'wisi-show-parse-error)
1626 (define-key ada-mode-map "\M-h" 'wisi-show-containing-or-previous-cache)
1627 (define-key ada-mode-map "\M-i" 'wisi-goto-statement-end)
1628 (define-key ada-mode-map "\M-j" 'wisi-show-cache)
1629 (define-key ada-mode-map "\M-k" 'wisi-show-token)
1632 (defun ada-wisi-number-p (token-text)
1633 "Return t if TOKEN-TEXT plus text after point matches the
1634 syntax for a real literal; otherwise nil. point is after
1635 TOKEN-TEXT; move point to just past token."
1636 ;; test in test/wisi/ada-number-literal.input
1638 ;; starts with a simple integer
1639 (let ((end (point)))
1640 ;; this first test must be very fast; it is executed for every token
1641 (when (and (memq (aref token-text 0) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
1642 (string-match "^[0-9]+" token-text))
1644 ((= (char-after) ?#)
1647 (if (not (looking-at "[0-9a-fA-F]+"))
1648 (progn (goto-char end) nil)
1650 (goto-char (match-end 0))
1652 ((= (char-after) ?#)
1657 ((= (char-after) ?.)
1660 (if (not (looking-at "[0-9a-fA-F]+"))
1661 (progn (goto-char end) nil)
1663 (goto-char (match-end 0))
1665 (if (not (= (char-after) ?#))
1666 (progn (goto-char end) nil)
1671 (if (not (memq (char-after) '(?e ?E)))
1672 ;; based real, no exponent
1677 (if (not (looking-at "[+-]?[0-9]+"))
1678 (progn (goto-char end) t)
1680 (goto-char (match-end 0))
1685 ;; missing trailing #
1686 (goto-char end) nil)
1689 ((= (char-after) ?.)
1690 ;; decimal real number?
1692 (if (not (looking-at "[0-9]+"))
1694 (progn (goto-char end) t)
1696 (setq end (goto-char (match-end 0)))
1698 (if (not (memq (char-after) '(?e ?E)))
1699 ;; decimal real, no exponent
1704 (if (not (looking-at "[+-]?[0-9]+"))
1705 (progn (goto-char end) t)
1707 (goto-char (match-end 0))
1717 (defun ada-wisi-setup ()
1718 "Set up a buffer for parsing Ada files with wisi."
1719 (wisi-setup '(ada-wisi-comment
1720 ada-wisi-before-cache
1721 ada-wisi-after-cache)
1722 'ada-wisi-post-parse-fail
1724 ada-grammar-wy--keyword-table
1725 ada-grammar-wy--token-table
1726 ada-grammar-wy--parse-table)
1728 ;; Handle escaped quotes in strings
1729 (setq wisi-string-quote-escape-doubled t)
1731 (set (make-local-variable 'comment-indent-function) 'wisi-comment-indent)
1734 (add-hook 'ada-mode-hook 'ada-wisi-setup)
1736 (setq ada-fix-context-clause 'ada-wisi-context-clause)
1737 (setq ada-goto-declaration-end 'ada-wisi-goto-declaration-end)
1738 (setq ada-goto-declaration-start 'ada-wisi-goto-declaration-start)
1739 (setq ada-goto-declarative-region-start 'ada-wisi-goto-declarative-region-start)
1740 (setq ada-goto-end 'wisi-goto-statement-end)
1741 (setq ada-goto-subunit-name 'ada-wisi-goto-subunit-name)
1742 (setq ada-in-paramlist-p 'ada-wisi-in-paramlist-p)
1743 (setq ada-indent-statement 'wisi-indent-statement)
1744 (setq ada-make-subprogram-body 'ada-wisi-make-subprogram-body)
1745 (setq ada-next-statement-keyword 'wisi-forward-statement-keyword)
1746 (setq ada-on-context-clause 'ada-wisi-on-context-clause)
1747 (setq ada-prev-statement-keyword 'wisi-backward-statement-keyword)
1748 (setq ada-reset-parser 'wisi-invalidate-cache)
1749 (setq ada-scan-paramlist 'ada-wisi-scan-paramlist)
1750 (setq ada-show-parse-error 'wisi-show-parse-error)
1751 (setq ada-which-function 'ada-wisi-which-function)
1754 (provide 'ada-indent-engine)