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 - 2015 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-with-params;; 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-without-params;; 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
567 single_protected_declaration
568 single_task_declaration
570 task_type_declaration)
572 (while (not (memq (wisi-cache-token containing) '(PROTECTED SUBTYPE TASK TYPE)))
573 (setq containing (wisi-goto-containing containing)))
576 ((eq (wisi-cache-token cache) 'WITH)
577 (let ((type-col (current-column))
578 (null_private (save-excursion (wisi-goto-end-1 cache)
579 (eq 'WITH (wisi-cache-token (wisi-backward-cache))))))
581 ((eq 'aspect_specification_opt (wisi-cache-nonterm cache))
583 ;; subtype Integer_String is String
584 ;; with Dynamic_Predicate => Integer'Value (Integer_String) in Integer
588 ;; protected Separate_Protected_Body
593 ;; test/ada_nominal.ads
594 ;; task type Task_Type_1 (Name : access String)
596 ;; Storage_Size => 512 + 256
601 ;; 'with null record;' or 'with private;'
602 ;; test/ada_mode-nominal.ads
603 ;; type Limited_Derived_Type_3 is abstract limited new Private_Type_1
605 ;; indenting 'with'; containing is 'is'
606 (+ type-col ada-indent-broken))
609 ;; test/ada_mode-nominal.ads
610 ;; type Unconstrained_Array_Type_3 is array (Integer range <>, Standard.Character range <>)
611 ;; of Object_Access_Type_1;
612 ;; indenting 'of'; containing is 'is'
614 ;; type Object_Access_Type_7
615 ;; is access all Integer;
616 ;; indenting 'is'; containing is 'type'
617 (+ type-col ada-indent-record-rel-type)))))
620 ;; test/ada_mode-nominal.ads
621 ;; type Limited_Derived_Type_2a is abstract limited new Private_Type_1
623 ;; indenting 'with record'
625 ;; test/access_in_record.ads
627 ;; is new Ada.Streams.Root_Stream_Type with record
629 ;; test/adacore_9717_001.ads A_Long_Name
630 ;; subtype A_Long_Name
631 ;; is Ada.Text_Io.Count;
633 (+ (current-column) ada-indent-broken))
636 (generic_instantiation
637 ;; test/ada_mode-generic_instantiation.ads
638 ;; procedure Procedure_7 is
639 ;; new Instance.Generic_Procedure (Integer, Function_1);
641 (+ (current-column) ada-indent-broken))
643 (generic_renaming_declaration
644 ;; indenting keyword following 'generic'
648 (cl-ecase (wisi-cache-token containing)
650 ;; test/ada_mode-nominal.ads
651 ;; Anon_Array_3 : array (1 .. 10)
654 (+ (current-indentation) ada-indent-broken))
658 ;; C_S_Controls : constant
661 ;; indenting 'CSCL_Type'
662 (+ (current-indentation) ada-indent-broken))
665 ;; test/ada_mode-nominal.adb
666 ;; Local_2 : constant Float
668 (+ (current-indentation) ada-indent-broken))
671 (private_extension_declaration
672 ;; test/ada_mode-nominal.ads
673 ;; type Limited_Derived_Type_3 is abstract limited
674 ;; new Private_Type_1 with private;
675 (+ (current-indentation) ada-indent-broken))
677 (private_type_declaration
679 ;; type Vector is tagged private
682 (current-indentation))
684 (qualified_expression
685 ;; test/ada_mode-nominal-child.ads
686 ;; Child_Obj_5 : constant Child_Type_1 :=
688 ;; (Parent_Element_1 => 1,
689 (ada-wisi-indent-cache ada-indent-broken containing))
692 (cl-case (wisi-cache-token containing)
694 (- (current-column) ada-indent-label))
697 ;; test/ada_mode-nominal.adb
703 (ada-wisi-indent-cache ada-indent-broken cache))
706 ((subprogram_body subprogram_declaration subprogram_specification null_procedure_declaration)
707 (cl-ecase (wisi-cache-token cache)
709 ;; test/ada_mode-nominal.ads
710 ;; procedure Procedure_1d
711 ;; (Item : in out Parent_Type_1;
712 ;; Item_1 : in Character;
713 ;; Item_2 : out Character)
716 (+ (current-column) ada-indent-broken))
719 ;; indenting 'overriding' following 'not'
722 ((PROCEDURE FUNCTION)
723 ;; indenting 'procedure' or 'function following 'overriding'
727 ;; indenting aspect specification on subprogram declaration
729 ;; procedure Foo (X : Integer;
731 ;; with Pre => X > 10 and
737 )))) ;; end statement-other
741 ((eq 'label_opt (wisi-cache-token cache))
742 (ada-wisi-indent-containing (+ ada-indent-label ada-indent) cache t))
745 (let ((containing-cache (wisi-get-containing-cache cache)))
746 (if (not containing-cache)
750 (cl-case (wisi-cache-class containing-cache)
751 ((block-start block-middle)
752 (wisi-goto-containing cache)
753 (cl-case (wisi-cache-nonterm containing-cache)
755 (+ (current-indentation) ada-indent))
758 (ada-wisi-indent-cache ada-indent containing-cache))
762 (ada-wisi-indent-list-break cache prev-token))
765 ;; defer to ada-wisi-after-cache
772 (defun ada-wisi-after-cache ()
773 "Point is at indentation, not before a cached token. Find previous
774 cached token, return new indentation for point."
776 (let ((start (point))
777 (prev-token (save-excursion (wisi-backward-token)))
778 (cache (wisi-backward-cache)))
785 (while (memq (wisi-cache-class cache) '(keyword name name-paren type))
786 ;; not useful for indenting
787 (setq cache (wisi-backward-cache)))
789 (cl-ecase (wisi-cache-class cache)
791 ;; indenting block/subprogram name after 'end'
792 (wisi-indent-current ada-indent-broken))
795 (cl-case (wisi-cache-token cache)
797 (cl-case (wisi-cache-nonterm cache)
799 ;; between 'case .. is' and first 'when'; most likely a comment
800 (ada-wisi-indent-containing 0 cache t))
803 (+ (ada-wisi-indent-containing ada-indent cache t)))
808 ;; test/ada_mode-conditional_expressions.adb
809 ;; K3 : Integer := (if
817 (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
818 ((statement if_statement elsif_statement_item) ada-indent)
819 ((if_expression elsif_expression_item) ada-indent-broken))))
820 (ada-wisi-indent-containing indent cache t)))
823 ;; between 'when' and '=>'
824 (+ (current-column) ada-indent-broken))
827 ;; block-middle keyword may not be on separate line:
828 ;; function Create (Model : in Integer;
829 ;; Context : in String) return String is
830 (ada-wisi-indent-containing ada-indent cache nil))
834 (cl-case (wisi-cache-nonterm cache)
836 ;; between 'when' and '=>'
837 (+ (current-column) ada-indent-broken))
840 (ada-wisi-indent-containing ada-indent-broken cache nil))
843 (ada-wisi-indent-containing (+ ada-indent-when ada-indent-broken) cache nil))
845 (t ;; other; normal block statement
846 (ada-wisi-indent-cache ada-indent cache))
850 ;; actual_parameter_part: test/ada_mode-nominal.adb
852 ;; Foo (Bar) + -- multi-line expression that happens to have a cache at a line start
854 ;; indenting '12'; don't indent relative to containing function name
856 ;; attribute_designator: test/ada_mode-nominal.adb
857 ;; raise Constraint_Error with Count'Image (Line (File)) &
859 ;; indenting '"foo"'; relative to raise
861 ;; test/ada_mode-slices.adb
862 ;; Put_Line(Day'Image(D1) & " - " & Day'Image(D2) & " = " &
863 ;; Integer'Image(N));
864 ;; indenting 'Integer'
865 (when (memq (wisi-cache-nonterm cache)
866 '(actual_parameter_part attribute_designator))
867 (setq cache (wisi-goto-containing cache)))
868 (ada-wisi-indent-containing ada-indent-broken cache nil))
871 (ada-wisi-indent-list-break cache prev-token))
874 ;; 1) A parenthesized expression, or the first item in an aggregate:
881 ;; we are indenting 'bar'
883 ;; 2) A parenthesized expression, or the first item in an
884 ;; aggregate, and there is whitespace between
885 ;; ( and the first token:
887 ;; test/ada_mode-parens.adb
888 ;; Local_9 : String := (
891 ;; 3) A parenthesized expression, or the first item in an
892 ;; aggregate, and there is a comment between
893 ;; ( and the first token:
895 ;; test/ada_mode-nominal.adb
898 ;; -- a comment between paren and first association
901 ;; test/ada_mode-parens.adb
904 ;; indenting 'Integer'
905 (let ((paren-column (current-column))
906 (start-is-comment (save-excursion (goto-char start) (looking-at comment-start-skip))))
907 (wisi-forward-token); point is now after paren
909 (skip-syntax-forward " >"); point is now on comment
910 (forward-comment (point-max)); point is now on first token
912 (if (= (point) start)
916 (+ paren-column 1 ada-indent-broken))))
918 ((return-with-params return-without-params)
919 ;; test/ada_mode-nominal.adb
920 ;; function Function_Access_1
921 ;; (A_Param : in Float)
924 ;; indenting 'Standard.Float'
926 ;; test/ada_mode-expression_functions.ads
927 ;; function Square (A : in Float) return Float
931 ;; test/ada_mode-nominal.ads
932 ;; function Function_2g
933 ;; (Param : in Private_Type_1)
937 (back-to-indentation)
938 (+ (current-column) ada-indent-broken))
941 (ada-wisi-indent-containing 0 cache nil))
944 (cl-ecase (wisi-cache-token cache)
950 ;; -- 'abort' indented with ada-indent-broken, since this is part
952 (ada-wisi-indent-containing ada-indent cache))
954 ;; test/subdir/ada_mode-separate_task_body.adb
956 ;; Local_3 : constant Float :=
959 ;; test/ada_mode-nominal.ads
960 ;; type Record_Type_3 (Discriminant_1 : access Integer) is tagged record
961 ;; Component_1 : Integer; -- end 2
964 ;; indenting 'Integer'; containing is ';'
965 (ada-wisi-indent-cache ada-indent-broken cache))
968 (cl-ecase (wisi-cache-nonterm cache)
970 (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
972 ;; test/with_use1.adb
973 (ada-wisi-indent-containing ada-indent-use cache))
976 ;; test/ada_mode-nominal.ads
977 ;; limited private with Ada.Strings.Bounded,
978 ;; --EMACSCMD:(test-face "Ada.Containers" 'default)
981 ;; test/with_use1.adb
982 (ada-wisi-indent-containing ada-indent-with cache))
988 ;; elsif Index_Switches + Max_Length <= Switches'Last
989 ;; and then Switches (Index_Switches + Max_Length) = '?'
990 (ada-wisi-indent-cache ada-indent-broken cache))
993 (let ((cache-col (current-column))
995 (line-end-pos (line-end-position))
996 (containing (wisi-goto-containing cache nil)))
997 (while (eq (wisi-cache-nonterm containing) 'association_list)
998 (setq containing (wisi-goto-containing containing nil)))
1000 (cl-ecase (wisi-cache-nonterm containing)
1001 ((actual_parameter_part aggregate)
1002 ;; ada_mode-generic_package.ads
1003 ;; with package A_Package_2 is new Ada.Text_IO.Integer_IO (Num =>
1004 ;; Formal_Signed_Integer_Type);
1005 ;; indenting 'Formal_Signed_...', point on '(Num'
1007 ;; test/ada_mode-parens.adb
1012 ;; indenting '1,' or '1 +'; point on '(1'
1014 ;; test/ada_mode-parens.adb
1015 ;; Local_13 : Local_11_Type
1018 ;; indenting 'Integer'; point on '(Integer'
1019 (+ (current-column) 1 ada-indent-broken))
1021 (aspect_specification_opt
1023 ;; with Pre => X > 10 and
1028 ;; indenting 'X < 50' or 'Y >= X'; cache is '=>', point is on '=>'
1029 ;; or indenting 'Post =>'; cache is ',', point is on 'with'
1030 (cl-ecase (wisi-cache-token cache)
1032 (+ (current-indentation) ada-indent-broken))
1035 (if (= (+ 2 cache-pos) line-end-pos)
1039 (goto-char cache-pos)
1040 (+ (current-indentation) ada-indent-broken))
1041 ;; with Pre => X > 10 and
1047 (cl-ecase (save-excursion (wisi-cache-token (wisi-goto-containing cache nil)))
1049 (ada-wisi-indent-containing (* 2 ada-indent-broken) cache))
1052 ((case_expression_alternative case_statement_alternative exception_handler)
1053 ;; containing is 'when'
1054 (+ (current-column) ada-indent))
1056 (generic_renaming_declaration
1057 ;; not indenting keyword following 'generic'
1058 (+ (current-column) ada-indent-broken))
1061 ;; test/ada_mode-quantified_expressions.adb
1062 ;; if (for some J in 1 .. 10 =>
1064 (ada-wisi-indent-containing ada-indent-broken cache))
1068 ;; test/ada_mode-nominal.adb
1072 ;; indenting 'accept'; point is on 'when'
1073 (+ (current-column) ada-indent))
1076 ;; test/generic_param.adb
1077 ;; case Item_Type is
1078 ;; when Fix | Airport =>
1081 (+ (current-column) ada-indent))
1086 (setq cache (wisi-goto-containing cache))
1087 (cl-ecase (wisi-cache-nonterm cache)
1088 (full_type_declaration
1089 ;; ada_mode/nominal.ads
1090 ;; type Limited_Derived_Type_1a is abstract limited new
1091 ;; Private_Type_1 with record
1092 ;; Component_1 : Integer;
1093 ;; indenting 'Private_Type_1'; look for 'record'
1094 (let ((type-column (current-column)))
1096 (if (wisi-forward-find-token 'RECORD (line-end-position) t)
1097 ;; 'record' on line being indented
1098 (+ type-column ada-indent-record-rel-type)
1099 ;; 'record' on later line
1100 (+ type-column ada-indent-broken))))
1102 ((formal_type_declaration
1103 ;; test/ada_mode-generic_package.ads
1104 ;; type Synchronized_Formal_Derived_Type is abstract synchronized new Formal_Private_Type and Interface_Type
1107 subtype_declaration)
1108 ;; test/ada_mode-nominal.ads
1109 ;; subtype Subtype_2 is Signed_Integer_Type range 10 ..
1112 (+ (current-column) ada-indent-broken))
1114 (null_procedure_declaration
1115 ;; ada_mode-nominal.ads
1116 ;; procedure Procedure_3b is
1119 (+ (current-column) ada-indent-broken))
1125 ;; C_S_Controls : constant
1130 (+ (current-column) 1))
1133 ;; ada_mode-nominal.ads
1134 ;; type Limited_Derived_Type_2 is abstract limited new Private_Type_1 with
1137 ;; test/ada_mode-generic_instantiation.ads
1138 ;; procedure Procedure_6 is new
1139 ;; Instance.Generic_Procedure (Integer, Function_1);
1140 ;; indenting 'Instance'; containing is 'new'
1141 (ada-wisi-indent-containing ada-indent-broken cache))
1144 ;; ada_mode-nominal.ads
1145 ;; Anon_Array_2 : array (1 .. 10) of
1147 (ada-wisi-indent-containing ada-indent-broken cache))
1150 ;; test/ada_mode-parens.adb
1153 (ada-wisi-indent-containing ada-indent-broken cache))
1156 (cl-ecase (wisi-cache-nonterm cache)
1158 ;; test/ada_mode-nominal-child.ads
1159 ;; (Default_Parent with
1161 ;; indenting '10'; containing is '('
1162 (ada-wisi-indent-containing 0 cache nil))
1164 (aspect_specification_opt
1166 ;; type Vector is tagged private
1168 ;; Constant_Indexing => Constant_Reference,
1169 ;; indenting 'Constant_Indexing'; point is on 'with'
1170 (+ (current-indentation) ada-indent-broken))
1173 ;; otherwise just hanging
1174 ((ACCEPT FUNCTION PROCEDURE RENAMES)
1175 (back-to-indentation)
1176 (+ (current-column) ada-indent-broken))
1181 (cl-case (wisi-cache-token cache)
1182 (WITH ;; with_clause
1183 (+ (current-column) ada-indent-with))
1186 ;; comment after label
1187 (+ (current-column) (- ada-indent-label)))
1190 ;; procedure Procedure_8
1191 ;; is new Instance.Generic_Procedure (Integer, Function_1);
1192 ;; indenting 'is'; hanging
1194 ;; test/ada_mode-conditional_expressions.adb
1195 ;; K3 : Integer := (if
1202 (ada-wisi-indent-cache ada-indent-broken cache))
1207 (defun ada-wisi-comment ()
1208 "Compute indentation of a comment. For `wisi-indent-calculate-functions'."
1209 ;; We know we are at the first token on a line. We check for comment
1210 ;; syntax, not comment-start, to accomodate gnatprep, skeleton
1211 ;; placeholders, etc.
1212 (when (and (not (= (point) (point-max))) ;; no char after EOB!
1213 (= 11 (syntax-class (syntax-after (point)))))
1215 ;; We are at a comment; indent to previous code or comment.
1217 ((and ada-indent-comment-col-0
1218 (= 0 (current-column)))
1222 (save-excursion (forward-line -1) (looking-at "\\s *$"))
1223 (save-excursion (forward-comment -1)(not (looking-at comment-start))))
1224 ;; comment is after a blank line or code; indent as if code
1226 ;; ada-wisi-before-cache will find the keyword _after_ the
1227 ;; comment, which could be a block-middle or block-end, and that
1228 ;; would align the comment with the block-middle, which is wrong. So
1229 ;; we only call ada-wisi-after-cache.
1231 ;; FIXME: need option to match gnat style check; change indentation to match (ie mod 3)
1232 (ada-wisi-after-cache))
1235 ;; comment is after a comment
1236 (forward-comment -1)
1240 (defun ada-wisi-post-parse-fail ()
1241 "For `wisi-post-parse-fail-hook'."
1243 (let ((start-cache (wisi-goto-start (or (wisi-get-cache (point)) (wisi-backward-cache)))))
1245 ;; nil when in a comment at point-min
1246 (indent-region (point) (wisi-cache-end start-cache)))
1248 (back-to-indentation))
1250 ;;;; ada-mode functions (alphabetical)
1252 (defun ada-wisi-declarative-region-start-p (cache)
1253 "Return t if cache is a keyword starting a declarative region."
1254 (cl-case (wisi-cache-token cache)
1257 (memq (wisi-cache-class cache) '(block-start block-middle)))
1261 (defun ada-wisi-context-clause ()
1262 "For `ada-fix-context-clause'."
1263 (wisi-validate-cache (point-max))
1265 (goto-char (point-min))
1271 (setq cache (wisi-forward-cache))
1272 (cl-case (wisi-cache-nonterm cache)
1273 (pragma (wisi-goto-end-1 cache))
1274 (use_clause (wisi-goto-end-1 cache))
1277 (setq begin (point-at-bol)))
1278 (wisi-goto-end-1 cache))
1280 ;; start of compilation unit
1281 (setq end (point-at-bol))
1288 (defun ada-wisi-on-context-clause ()
1289 "For `ada-on-context-clause'."
1292 ;; Don't require parse of large file just for ada-find-other-file
1293 (and (< (point-max) wisi-size-threshold)
1294 (setq cache (wisi-goto-statement-start))
1295 (memq (wisi-cache-nonterm cache) '(use_clause with_clause))
1298 (defun ada-wisi-goto-subunit-name ()
1299 "For `ada-goto-subunit-name'."
1300 (wisi-validate-cache (point-max))
1301 (if (not (> wisi-cache-max (point)))
1303 (message "parse failed; can't goto subunit name")
1310 ;; move to top declaration
1311 (goto-char (point-min))
1312 (setq cache (or (wisi-get-cache (point))
1313 (wisi-forward-cache)))
1315 (cl-case (wisi-cache-nonterm cache)
1316 ((pragma use_clause with_clause)
1317 (wisi-goto-end-1 cache)
1318 (setq cache (wisi-forward-cache)))
1320 ;; start of compilation unit
1323 (when (eq (wisi-cache-nonterm cache) 'subunit)
1324 (wisi-forward-find-class 'name (point-max)) ;; parent name
1325 (wisi-forward-token)
1326 (wisi-forward-find-class 'name (point-max)) ;; subunit name
1327 (setq name-pos (point)))
1330 (goto-char name-pos))
1333 (defun ada-wisi-goto-declaration-start ()
1334 "For `ada-goto-declaration-start', which see.
1335 Also return cache at start."
1336 (wisi-validate-cache (point))
1337 (unless (> wisi-cache-max (point))
1338 (error "parse failed; can't goto declarative-region-start"))
1340 (let ((cache (wisi-get-cache (point)))
1343 (setq cache (wisi-backward-cache)))
1344 ;; cache is null at bob
1349 (cl-case (wisi-cache-nonterm cache)
1350 ((generic_package_declaration generic_subprogram_declaration)
1351 (eq (wisi-cache-token cache) 'GENERIC))
1353 ((package_body package_declaration)
1354 (eq (wisi-cache-token cache) 'PACKAGE))
1356 ((protected_body protected_type_declaration single_protected_declaration)
1357 (eq (wisi-cache-token cache) 'PROTECTED))
1359 ((subprogram_body subprogram_declaration null_procedure_declaration)
1360 (memq (wisi-cache-token cache) '(NOT OVERRIDING FUNCTION PROCEDURE)))
1362 (task_type_declaration
1363 (eq (wisi-cache-token cache) 'TASK))
1367 (setq cache (wisi-goto-containing cache nil))))
1372 (defun ada-wisi-goto-declaration-end ()
1373 "For `ada-goto-declaration-end', which see."
1374 ;; first goto-declaration-start, so we get the right end, not just
1375 ;; the current statement end.
1376 (wisi-goto-end-1 (ada-wisi-goto-declaration-start)))
1378 (defun ada-wisi-goto-declarative-region-start ()
1379 "For `ada-goto-declarative-region-start', which see."
1380 (wisi-validate-cache (point))
1381 (unless (> wisi-cache-max (point))
1382 (error "parse failed; can't goto declarative-region-start"))
1388 (wisi-get-cache (point))
1389 ;; we use forward-cache here, to handle the case where point is after a subprogram declaration:
1392 ;; function ... is ... end;
1394 ;; function ... is ... end;
1395 (wisi-forward-cache))))
1397 (if (ada-wisi-declarative-region-start-p cache)
1399 (wisi-forward-token)
1401 (cl-case (wisi-cache-class cache)
1402 ((block-middle block-end)
1403 (setq cache (wisi-prev-statement-cache cache)))
1406 ;; 1) test/ada_mode-nominal.adb
1407 ;; protected body Protected_1 is -- target 2
1411 ;; 2) test/ada_mode-nominal.adb
1412 ;; function Function_Access_1
1413 ;; (A_Param <point> : in Float)
1419 ;; 3) test/ada_mode-nominal-child.adb
1420 ;; overriding <point> function Function_2c (Param : in Child_Type_1)
1422 ;; is -- target Function_2c
1427 (setq cache (wisi-goto-containing cache t))
1429 (cl-case (wisi-cache-nonterm cache)
1431 (while (not (eq 'IS (wisi-cache-token cache)))
1432 (setq cache (wisi-next-statement-cache cache))))
1434 (setq cache (wisi-goto-containing cache t)))
1437 (setq cache (wisi-goto-containing cache t)))
1439 (when first (setq first nil)))
1442 (defun ada-wisi-in-paramlist-p ()
1443 "For `ada-in-paramlist-p'."
1444 (wisi-validate-cache (point))
1445 ;; (info "(elisp)Parser State" "*syntax-ppss*")
1446 (let* ((parse-result (syntax-ppss))
1448 (and (> (nth 0 parse-result) 0)
1449 ;; cache is nil if the parse failed
1450 (setq cache (wisi-get-cache (nth 1 parse-result)))
1451 (eq 'formal_part (wisi-cache-nonterm cache)))
1454 (defun ada-wisi-make-subprogram-body ()
1455 "For `ada-make-subprogram-body'."
1456 (wisi-validate-cache (point))
1457 (when wisi-parse-failed
1458 (error "syntax parse failed; cannot create body"))
1460 (let* ((begin (point))
1461 (end (save-excursion (wisi-forward-find-class 'statement-end (point-max)) (point)))
1462 (cache (wisi-forward-find-class 'name end))
1463 (name (buffer-substring-no-properties
1465 (+ (point) (wisi-cache-last cache)))))
1468 (insert " is begin\nnull;\nend ");; legal syntax; parse does not fail
1472 ;; newline after body to separate from next body
1473 (newline-and-indent)
1474 (indent-region begin (point))
1476 (back-to-indentation); before 'null;'
1479 (defun ada-wisi-scan-paramlist (begin end)
1480 "For `ada-scan-paramlist'."
1481 (wisi-validate-cache end)
1482 (when (< wisi-cache-max end)
1483 (error "parse failed; can't scan paramlist"))
1505 (let ((token-text (wisi-forward-token)))
1506 (setq token (nth 0 token-text))
1507 (setq text (wisi-token-text token-text)))
1509 ((equal token 'COMMA) nil);; multiple identifiers
1511 ((equal token 'COLON)
1512 ;; identifiers done. find type-begin; there may be no mode
1513 (skip-syntax-forward " ")
1514 (setq type-begin (point))
1516 (while (member (car (wisi-forward-token)) '(ALIASED IN OUT NOT NULL ACCESS CONSTANT PROTECTED))
1517 (skip-syntax-forward " ")
1518 (setq type-begin (point)))))
1520 ((equal token 'ALIASED) (setq aliased-p t))
1521 ((equal token 'IN) (setq in-p t))
1522 ((equal token 'OUT) (setq out-p t))
1523 ((and (not type-end)
1524 (member token '(NOT NULL)))
1525 ;; "not", "null" could be part of the default expression
1526 (setq not-null-p t))
1527 ((equal token 'ACCESS) (setq access-p t))
1528 ((equal token 'CONSTANT) (setq constant-p t))
1529 ((equal token 'PROTECTED) (setq protected-p t))
1531 ((equal token 'COLON_EQUAL)
1532 (setq type-end (save-excursion (backward-char 2) (skip-syntax-backward " ") (point)))
1533 (skip-syntax-forward " ")
1534 (setq default-begin (point))
1535 (wisi-forward-find-token 'SEMICOLON end t))
1537 ((member token '(SEMICOLON RIGHT_PAREN))
1538 (when (not type-end)
1539 (setq type-end (save-excursion (backward-char 1) (skip-syntax-backward " ") (point))))
1541 (setq type (buffer-substring-no-properties type-begin type-end))
1544 (setq default (buffer-substring-no-properties default-begin (1- (point)))))
1546 (when (equal token 'RIGHT_PAREN)
1549 (setq param (list (reverse identifiers)
1550 aliased-p in-p out-p not-null-p access-p constant-p protected-p
1552 (cl-pushnew param paramlist :test #'equal)
1553 (setq identifiers nil
1568 (when (not type-begin)
1569 (cl-pushnew text identifiers :test #'equal)))
1573 (defun ada-wisi-which-function-1 (keyword add-body)
1574 "Used in `ada-wisi-which-function'."
1575 (let* ((cache (wisi-forward-find-class 'name (point-max)))
1576 (result (wisi-cache-text cache)))
1578 (when (not ff-function-name)
1579 (setq ff-function-name
1582 (when add-body "\\s-+body")
1588 (defun ada-wisi-which-function ()
1589 "For `ada-which-function'."
1590 (wisi-validate-cache (point))
1593 (cache (condition-case nil (ada-wisi-goto-declaration-start) (error nil))))
1595 ;; bob or failed parse
1598 (cl-case (wisi-cache-nonterm cache)
1599 ((generic_package_declaration generic_subprogram_declaration)
1600 ;; name is after next statement keyword
1601 (wisi-next-statement-cache cache)
1602 (setq cache (wisi-get-cache (point))))
1605 ;; add or delete 'body' as needed
1606 (cl-ecase (wisi-cache-nonterm cache)
1608 (setq result (ada-wisi-which-function-1 "package" nil)))
1610 ((package_declaration
1611 generic_package_declaration) ;; after 'generic'
1612 (setq result (ada-wisi-which-function-1 "package" t)))
1615 (setq result (ada-wisi-which-function-1 "protected" nil)))
1617 ((protected_type_declaration single_protected_declaration)
1618 (setq result (ada-wisi-which-function-1 "protected" t)))
1620 ((subprogram_declaration
1621 generic_subprogram_declaration ;; after 'generic'
1622 null_procedure_declaration)
1623 (setq result (ada-wisi-which-function-1
1624 (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
1625 nil))) ;; no 'body' keyword in subprogram bodies
1628 (setq result (ada-wisi-which-function-1
1629 (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
1632 (task_type_declaration
1633 (setq result (ada-wisi-which-function-1 "task" t)))
1639 (defun ada-wisi-debug-keys ()
1640 "Add debug key definitions to `ada-mode-map'."
1642 (define-key ada-mode-map "\M-e" 'wisi-show-parse-error)
1643 (define-key ada-mode-map "\M-h" 'wisi-show-containing-or-previous-cache)
1644 (define-key ada-mode-map "\M-i" 'wisi-goto-statement-end)
1645 (define-key ada-mode-map "\M-j" 'wisi-show-cache)
1646 (define-key ada-mode-map "\M-k" 'wisi-show-token)
1649 (defun ada-wisi-number-p (token-text)
1650 "Return t if TOKEN-TEXT plus text after point matches the
1651 syntax for a real literal; otherwise nil. point is after
1652 TOKEN-TEXT; move point to just past token."
1653 ;; test in test/wisi/ada-number-literal.input
1655 ;; starts with a simple integer
1656 (let ((end (point)))
1657 ;; this first test must be very fast; it is executed for every token
1658 (when (and (memq (aref token-text 0) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
1659 (string-match "^[0-9_]+$" token-text))
1661 ((= (char-after) ?#)
1664 (if (not (looking-at "[0-9a-fA-F_]+"))
1665 (progn (goto-char end) nil)
1667 (goto-char (match-end 0))
1669 ((= (char-after) ?#)
1674 ((= (char-after) ?.)
1677 (if (not (looking-at "[0-9a-fA-F]+"))
1678 (progn (goto-char end) nil)
1680 (goto-char (match-end 0))
1682 (if (not (= (char-after) ?#))
1683 (progn (goto-char end) nil)
1688 (if (not (memq (char-after) '(?e ?E)))
1689 ;; based real, no exponent
1694 (if (not (looking-at "[+-]?[0-9]+"))
1695 (progn (goto-char end) t)
1697 (goto-char (match-end 0))
1702 ;; missing trailing #
1703 (goto-char end) nil)
1706 ((= (char-after) ?.)
1707 ;; decimal real number?
1709 (if (not (looking-at "[0-9_]+"))
1711 (progn (goto-char end) t)
1713 (setq end (goto-char (match-end 0)))
1715 (if (not (memq (char-after) '(?e ?E)))
1716 ;; decimal real, no exponent
1721 (if (not (looking-at "[+-]?[0-9]+"))
1722 (progn (goto-char end) t)
1724 (goto-char (match-end 0))
1734 (defun ada-wisi-setup ()
1735 "Set up a buffer for parsing Ada files with wisi."
1736 (wisi-setup '(ada-wisi-comment
1737 ada-wisi-before-cache
1738 ada-wisi-after-cache)
1739 'ada-wisi-post-parse-fail
1741 ada-grammar-wy--keyword-table
1742 ada-grammar-wy--token-table
1743 ada-grammar-wy--parse-table)
1745 ;; Handle escaped quotes in strings
1746 (setq wisi-string-quote-escape-doubled t)
1748 (set (make-local-variable 'comment-indent-function) 'wisi-comment-indent)
1751 (add-hook 'ada-mode-hook 'ada-wisi-setup)
1753 (setq ada-fix-context-clause 'ada-wisi-context-clause)
1754 (setq ada-goto-declaration-end 'ada-wisi-goto-declaration-end)
1755 (setq ada-goto-declaration-start 'ada-wisi-goto-declaration-start)
1756 (setq ada-goto-declarative-region-start 'ada-wisi-goto-declarative-region-start)
1757 (setq ada-goto-end 'wisi-goto-statement-end)
1758 (setq ada-goto-subunit-name 'ada-wisi-goto-subunit-name)
1759 (setq ada-in-paramlist-p 'ada-wisi-in-paramlist-p)
1760 (setq ada-indent-statement 'wisi-indent-statement)
1761 (setq ada-make-subprogram-body 'ada-wisi-make-subprogram-body)
1762 (setq ada-next-statement-keyword 'wisi-forward-statement-keyword)
1763 (setq ada-on-context-clause 'ada-wisi-on-context-clause)
1764 (setq ada-prev-statement-keyword 'wisi-backward-statement-keyword)
1765 (setq ada-reset-parser 'wisi-invalidate-cache)
1766 (setq ada-scan-paramlist 'ada-wisi-scan-paramlist)
1767 (setq ada-show-parse-error 'wisi-show-parse-error)
1768 (setq ada-which-function 'ada-wisi-which-function)
1771 (provide 'ada-indent-engine)