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 (cl-case (wisi-cache-nonterm cache)
300 ((function_specification procedure_specification)
301 ;; test/ada_mode-nominal.ads
305 ;; Procedure_1c (Item : in out Parent_Type_1);
306 ;; indenting 'Procedure_1c'
308 ;; not overriding function
309 ;; Function_2e (Param : in Parent_Type_1) return Float;
310 ;; indenting 'Function_2e'
311 (ada-wisi-indent-containing ada-indent-broken cache t))
314 ;; defer to ada-wisi-after-cache, for consistency
319 ;; defer to ada-wisi-after-cache, for consistency
323 (let ((containing (wisi-goto-containing cache)))
324 (cl-case (wisi-cache-token containing)
326 ;; test/ada_mode-parens.adb
327 ;; A : Matrix_Type :=
331 (ada-wisi-indent-containing 0 containing))
334 (setq containing (wisi-goto-containing containing))
335 (cl-ecase (wisi-cache-token containing)
337 ;; test/ada_mode-long_paren.adb
341 ;; (RX_Torque_Subaddress |
342 ;; indenting (RX_Torque
343 (ada-wisi-indent-containing ada-indent-broken containing t))
345 ;; test/ada_mode-parens.adb
348 ;; indenting '(1 => 12'; containing is '=>'
349 (ada-wisi-indent-cache (1- ada-indent) containing))
351 ;; test/ada_mode-conditional_expressions.adb
354 ;; indenting '(if'; containing is '=>'
355 (+ (current-column) -1 ada-indent))
358 ((FUNCTION PROCEDURE)
359 ;; test/ada_mode-nominal.adb
360 ;; function Function_Access_11
361 ;; (A_Param : in Float)
362 ;; -- EMACSCMD:(test-face "function" font-lock-keyword-face)
363 ;; return access function
364 ;; (A_Param : in Float)
366 ;; Standard.Float -- Ada mode 4.01, GPS do this differently
367 ;; indenting second '(A_Param)
368 (+ (current-indentation) -1 ada-indent))
371 ;; test/ada_mode-parens.adb
377 (+ (current-column) 1 ada-indent-broken))
380 ;; test/ada_mode-nominal.adb
382 ;; when Local_1 = 0 and not
384 ;; indenting (Local_2
387 ;; (X : Integer) when Local_1 = 0 and not
389 (+ (ada-wisi-current-indentation) ada-indent-broken))
397 ;; test/ada_mode-parens.adb
405 ;; test/ada_mode-parens.adb
406 ;; Local_11 : Local_11_Type := Local_11_Type'
411 (+ (ada-wisi-current-indentation) ada-indent-broken))
415 ((memq (wisi-cache-class containing) '(block-start statement-start))
416 ;; test/ada_mode-nominal.adb
420 (ada-wisi-indent-cache ada-indent-broken containing))
423 ;; Open paren in an expression.
425 ;; test/ada_mode-conditional_expressions.adb
427 ;; (case J is when 42 => -1, when Integer'First .. 41 => 0, when others => 1);
429 (ada-wisi-indent-containing ada-indent-broken containing t))
433 (return-1;; parameter list
434 (let ((return-pos (point)))
435 (wisi-goto-containing cache nil) ;; matching 'function'
437 ((<= ada-indent-return 0)
438 ;; indent relative to "("
439 (wisi-forward-find-class 'open-paren return-pos)
440 (+ (current-column) (- ada-indent-return)))
443 (+ (current-column) ada-indent-return))
446 (return-2;; no parameter list
447 (wisi-goto-containing cache nil) ;; matching 'function'
448 (+ (current-column) ada-indent-broken))
451 (ada-wisi-indent-containing ada-indent-broken cache t))
454 (let ((containing (wisi-goto-containing cache nil)))
455 (cl-case (wisi-cache-token cache)
457 (+ (current-column) ada-indent-broken))
461 ;; elsif Current_Argument < CL.Argument_Count then
462 (ada-wisi-indent-cache 0 containing))
465 (cl-ecase (wisi-cache-nonterm containing)
466 ((generic_renaming_declaration subprogram_renaming_declaration)
467 (wisi-forward-find-token '(FUNCTION PROCEDURE) pos-0)
468 (let ((pos-subprogram (point))
470 ;; this is wrong for one return access
471 ;; function case: overriding function Foo
472 ;; return access Bar (...) renames ...;
473 (wisi-forward-find-token 'LEFT_PAREN pos-0 t)))
475 (if (<= ada-indent-renames 0)
476 ;; indent relative to paren
477 (+ (current-column) (- ada-indent-renames))
478 ;; else relative to line containing keyword
479 (goto-char pos-subprogram)
480 (+ (current-indentation) ada-indent-renames))
483 (goto-char pos-subprogram)
484 (+ (current-indentation) ada-indent-broken))
487 (object_renaming_declaration
488 (+ (current-indentation) ada-indent-broken))
492 (while (not (wisi-cache-nonterm containing))
493 (setq containing (wisi-goto-containing containing)))
495 (cl-ecase (wisi-cache-nonterm containing)
498 (+ (current-column) 1))
502 ;; 1 => -- Used to be aligned on "CSCL_Type'"
503 ;; -- aligned with previous comment.
504 ;; IO_CPU_Control_State_S_Pkg.CPU2_Fault_Status_Type'
505 (ada-wisi-indent-cache ada-indent-broken containing))
509 (+ (current-column) ada-indent-broken))
511 (component_declaration
512 ;; test/ada_mode-nominal.ads record_type_3
513 (+ (current-column) ada-indent-broken))
517 (+ (current-column) ada-indent-broken))
519 (formal_package_declaration
520 ;; test/ada_mode-generic_package.ads
521 ;; with package A_Package_7 is
522 ;; new Ada.Text_IO.Integer_IO (Num => Formal_Signed_Integer_Type);
524 (+ (current-column) ada-indent-broken))
526 (full_type_declaration
527 ;; test/ada_mode-nominal.ads
528 ;; type Unconstrained_Array_Type_3 is array (Integer range <>, Standard.Character range <>)
529 ;; of Object_Access_Type_1;
532 ;; type Object_Access_Type_7
533 ;; is access all Integer;
536 ;; type Limited_Derived_Type_1 is abstract limited new Private_Type_1 with
538 ;; indenting 'record'
540 ;; type Limited_Derived_Type_3 is abstract limited new Private_Type_1
544 ;; type Limited_Derived_Type_2a is abstract limited new Private_Type_1
546 ;; indenting 'with record'
547 (while (not (eq 'TYPE (wisi-cache-token containing)))
548 (setq containing (wisi-goto-containing containing)))
551 ((eq (wisi-cache-token cache) 'RECORD)
552 (+ (current-column) ada-indent-record-rel-type))
554 ((eq (wisi-cache-token cache) 'WITH)
555 (let ((type-col (current-column)))
556 (wisi-goto-end-1 cache)
557 (if (eq 'WITH (wisi-cache-token (wisi-backward-cache)))
558 ;; 'with null record;' or 'with private;'
559 (+ type-col ada-indent-broken)
560 (+ type-col ada-indent-record-rel-type))))
563 (+ (current-column) ada-indent-broken))
566 (generic_instantiation
567 ;; test/ada_mode-generic_instantiation.ads
568 ;; procedure Procedure_7 is
569 ;; new Instance.Generic_Procedure (Integer, Function_1);
571 (+ (current-column) ada-indent-broken))
573 (generic_renaming_declaration
574 ;; indenting keyword following 'generic'
578 (cl-ecase (wisi-cache-token containing)
580 ;; test/ada_mode-nominal.ads
581 ;; Anon_Array_3 : array (1 .. 10)
584 (+ (current-indentation) ada-indent-broken))
588 ;; C_S_Controls : constant
591 ;; indenting 'CSCL_Type'
592 (+ (current-indentation) ada-indent-broken))
595 ;; test/ada_mode-nominal.adb
596 ;; Local_2 : constant Float
598 (+ (current-indentation) ada-indent-broken))
601 (private_type_declaration
603 ;; type Vector is tagged private
606 (current-indentation))
608 (qualified_expression
609 ;; test/ada_mode-nominal-child.ads
610 ;; Child_Obj_5 : constant Child_Type_1 :=
612 ;; (Parent_Element_1 => 1,
613 (ada-wisi-indent-cache ada-indent-broken containing))
616 (cl-case (wisi-cache-token containing)
618 (- (current-column) ada-indent-label))
621 ;; test/ada_mode-nominal.adb
627 (ada-wisi-indent-cache ada-indent-broken cache))
630 ((subprogram_body subprogram_declaration subprogram_specification null_procedure_declaration)
631 (cl-ecase (wisi-cache-token cache)
633 ;; indenting 'overriding' following 'not'
636 ((PROCEDURE FUNCTION)
637 ;; indenting 'procedure' or 'function following 'overriding'
641 ;; indenting aspect specification on subprogram declaration
643 ;; procedure Foo (X : Integer;
645 ;; with Pre => X > 10 and
651 ;; test/adacore_9717_001.ads A_Long_Name
652 (+ (current-column) ada-indent-broken))
654 ))))) ;; end statement-other
658 ((eq 'label_opt (wisi-cache-token cache))
659 (ada-wisi-indent-containing (+ ada-indent-label ada-indent) cache t))
662 (let ((containing-cache (wisi-get-containing-cache cache)))
663 (if (not containing-cache)
667 (cl-case (wisi-cache-class containing-cache)
668 ((block-start block-middle)
669 (wisi-goto-containing cache)
670 (cl-case (wisi-cache-nonterm containing-cache)
672 (+ (current-indentation) ada-indent))
675 (ada-wisi-indent-cache ada-indent containing-cache))
679 (ada-wisi-indent-list-break cache prev-token))
682 ;; defer to ada-wisi-after-cache
688 (ada-wisi-indent-containing ada-indent-broken cache t))
692 (defun ada-wisi-after-cache ()
693 "Point is at indentation, not before a cached token. Find previous
694 cached token, return new indentation for point."
695 (let ((start (point))
696 (prev-token (save-excursion (wisi-backward-token)))
697 (cache (wisi-backward-cache)))
704 (while (memq (wisi-cache-class cache) '(name name-paren type))
705 ;; not useful for indenting
706 (setq cache (wisi-backward-cache)))
708 (cl-ecase (wisi-cache-class cache)
710 ;; indenting block/subprogram name after 'end'
711 (wisi-indent-current ada-indent-broken))
714 (cl-case (wisi-cache-token cache)
716 (cl-case (wisi-cache-nonterm cache)
718 ;; between 'case .. is' and first 'when'; most likely a comment
719 (ada-wisi-indent-containing 0 cache t))
722 (+ (ada-wisi-indent-containing ada-indent cache t)))
727 (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
728 ((statement if_statement elsif_statement_item) ada-indent)
729 ((if_expression elsif_expression_item) ada-indent-broken))))
730 (ada-wisi-indent-containing indent cache t)))
733 ;; between 'when' and '=>'
734 (+ (current-column) ada-indent-broken))
737 ;; block-middle keyword may not be on separate line:
738 ;; function Create (Model : in Integer;
739 ;; Context : in String) return String is
740 (ada-wisi-indent-containing ada-indent cache nil))
744 (cl-case (wisi-cache-nonterm cache)
746 ;; between 'when' and '=>'
747 (+ (current-column) ada-indent-broken))
750 (ada-wisi-indent-containing ada-indent-broken cache nil))
753 (ada-wisi-indent-containing (+ ada-indent-when ada-indent-broken) cache nil))
755 (t ;; other; normal block statement
756 (ada-wisi-indent-cache ada-indent cache))
760 ;; actual_parameter_part: test/ada_mode-nominal.adb
762 ;; Foo (Bar) + -- multi-line expression that happens to have a cache at a line start
764 ;; indenting '12'; don't indent relative to containing function name
766 ;; attribute_designator: test/ada_mode-nominal.adb
767 ;; raise Constraint_Error with Count'Image (Line (File)) &
769 ;; indenting '"foo"'; relative to raise
771 ;; test/ada_mode-slices.adb
772 ;; Put_Line(Day'Image(D1) & " - " & Day'Image(D2) & " = " &
773 ;; Integer'Image(N));
774 ;; indenting 'Integer'
775 (when (memq (wisi-cache-nonterm cache)
776 '(actual_parameter_part attribute_designator))
777 (setq cache (wisi-goto-containing cache)))
778 (ada-wisi-indent-containing ada-indent-broken cache nil))
781 (ada-wisi-indent-list-break cache prev-token))
784 ;; 1) A parenthesized expression, or the first item in an aggregate:
791 ;; we are indenting 'bar'
793 ;; 2) A parenthesized expression, or the first item in an
794 ;; aggregate, and there is whitespace between
795 ;; ( and the first token:
797 ;; test/ada_mode-parens.adb
798 ;; Local_9 : String := (
801 ;; 3) A parenthesized expression, or the first item in an
802 ;; aggregate, and there is a comment between
803 ;; ( and the first token:
805 ;; test/ada_mode-nominal.adb
808 ;; -- a comment between paren and first association
811 ;; test/ada_mode-parens.adb
814 ;; indenting 'Integer'
815 (let ((paren-column (current-column))
816 (start-is-comment (save-excursion (goto-char start) (looking-at comment-start-skip))))
817 (wisi-forward-token t); point is now after paren
819 (skip-syntax-forward " >"); point is now on comment
820 (forward-comment (point-max)); point is now on first token
822 (if (= (point) start)
826 (+ paren-column 1 ada-indent-broken))))
829 ;; hanging. Intent relative to line containing matching 'function'
830 (ada-prev-statement-keyword)
831 (back-to-indentation)
832 (+ (current-column) ada-indent-broken))
835 (ada-wisi-indent-containing 0 cache nil))
838 (cl-ecase (wisi-cache-token cache)
844 ;; -- 'abort' indented with ada-indent-broken, since this is part
846 (ada-wisi-indent-containing ada-indent cache))
848 ;; test/subdir/ada_mode-separate_task_body.adb
850 ;; Local_3 : constant Float :=
852 (ada-wisi-indent-cache ada-indent-broken cache))
855 (cl-ecase (wisi-cache-nonterm cache)
857 (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
859 ;; test/with_use1.adb
860 (ada-wisi-indent-containing ada-indent-use cache))
863 ;; test/ada_mode-nominal.ads
864 ;; limited private with Ada.Strings.Bounded,
865 ;; --EMACSCMD:(test-face "Ada.Containers" 'default)
868 ;; test/with_use1.adb
869 (ada-wisi-indent-containing ada-indent-with cache))
875 ;; elsif Index_Switches + Max_Length <= Switches'Last
876 ;; and then Switches (Index_Switches + Max_Length) = '?'
877 (ada-wisi-indent-cache ada-indent-broken cache))
880 (let ((cache-col (current-column))
882 (line-end-pos (line-end-position))
883 (containing (wisi-goto-containing cache nil)))
884 (while (eq (wisi-cache-nonterm containing) 'association_list)
885 (setq containing (wisi-goto-containing containing nil)))
887 (cl-ecase (wisi-cache-nonterm containing)
888 ((actual_parameter_part aggregate)
889 ;; ada_mode-generic_package.ads
890 ;; with package A_Package_2 is new Ada.Text_IO.Integer_IO (Num =>
891 ;; Formal_Signed_Integer_Type);
892 ;; indenting 'Formal_Signed_...', point on '(Num'
894 ;; test/ada_mode-parens.adb
899 ;; indenting '1,' or '1 +'; point on '(1'
900 (+ (current-column) 1 ada-indent-broken))
902 (aspect_specification_opt
904 ;; with Pre => X > 10 and
909 ;; indenting 'X < 50' or 'Y >= X'; cache is '=>', point is on '=>'
910 ;; or indenting 'Post =>'; cache is ',', point is on 'with'
911 (cl-ecase (wisi-cache-token cache)
913 (+ (current-indentation) ada-indent-broken))
916 (if (= (+ 2 cache-pos) line-end-pos)
920 (goto-char cache-pos)
921 (+ (current-indentation) ada-indent-broken))
922 ;; with Pre => X > 10 and
928 (cl-ecase (save-excursion (wisi-cache-token (wisi-goto-containing cache nil)))
930 (ada-wisi-indent-containing (* 2 ada-indent-broken) cache))
933 ((case_expression_alternative case_statement_alternative exception_handler)
934 ;; containing is 'when'
935 (+ (current-column) ada-indent))
937 (generic_renaming_declaration
938 ;; not indenting keyword following 'generic'
939 (+ (current-column) ada-indent-broken))
942 ;; test/ada_mode-quantified_expressions.adb
943 ;; if (for some J in 1 .. 10 =>
945 (ada-wisi-indent-containing ada-indent-broken cache))
949 ;; test/ada_mode-nominal.adb
953 ;; indenting 'accept'; point is on 'when'
954 (+ (current-column) ada-indent))
957 ;; test/generic_param.adb
959 ;; when Fix | Airport =>
962 (+ (current-column) ada-indent))
967 (setq cache (wisi-goto-containing cache))
968 (cl-ecase (wisi-cache-nonterm cache)
969 (full_type_declaration
970 ;; ada_mode/nominal.ads
971 ;; type Limited_Derived_Type_1a is abstract limited new
972 ;; Private_Type_1 with record
973 ;; Component_1 : Integer;
974 ;; indenting 'Private_Type_1'; look for 'record'
975 (let ((type-column (current-column)))
977 (if (wisi-forward-find-token 'RECORD (line-end-position) t)
978 ;; 'record' on line being indented
979 (+ type-column ada-indent-record-rel-type)
980 ;; 'record' on later line
981 (+ type-column ada-indent-broken))))
983 ((formal_type_declaration
984 ;; test/ada_mode-generic_package.ads
985 ;; type Synchronized_Formal_Derived_Type is abstract synchronized new Formal_Private_Type and Interface_Type
989 ;; test/ada_mode-nominal.ads
990 ;; subtype Subtype_2 is Signed_Integer_Type range 10 ..
993 (+ (current-column) ada-indent-broken))
998 ;; C_S_Controls : constant
1003 (+ (current-column) 1))
1006 ;; ada_mode-nominal.ads
1007 ;; type Limited_Derived_Type_2 is abstract limited new Private_Type_1 with
1010 ;; test/ada_mode-generic_instantiation.ads
1011 ;; procedure Procedure_6 is new
1012 ;; Instance.Generic_Procedure (Integer, Function_1);
1013 ;; indenting 'Instance'; containing is 'new'
1014 (ada-wisi-indent-containing ada-indent-broken cache))
1017 ;; ada_mode-nominal.ads
1018 ;; Anon_Array_2 : array (1 .. 10) of
1020 (ada-wisi-indent-containing ada-indent-broken cache))
1023 ;; test/ada_mode-parens.adb
1026 (ada-wisi-indent-containing ada-indent-broken cache))
1029 (cl-case (wisi-cache-nonterm cache)
1031 ;; test/ada_mode-nominal-child.ads
1032 ;; (Default_Parent with
1034 ;; indenting '10'; containing is '('
1035 (ada-wisi-indent-containing 0 cache nil))
1037 (aspect_specification_opt
1039 ;; type Vector is tagged private
1041 ;; Constant_Indexing => Constant_Reference,
1042 ;; indenting 'Constant_Indexing'; point is on 'with'
1043 (+ (current-indentation) ada-indent-broken))
1046 ;; otherwise just hanging
1047 ((ACCEPT FUNCTION PROCEDURE RENAMES)
1048 (back-to-indentation)
1049 (+ (current-column) ada-indent-broken))
1054 (cl-case (wisi-cache-token cache)
1055 (WITH ;; with_clause
1056 (+ (current-column) ada-indent-with))
1059 ;; comment after label
1060 (+ (current-column) (- ada-indent-label)))
1063 ;; procedure Procedure_8
1064 ;; is new Instance.Generic_Procedure (Integer, Function_1);
1065 ;; indenting 'is'; hanging
1066 ;; (+ (current-column) ada-indent-broken))
1067 (ada-wisi-indent-cache ada-indent-broken cache))
1072 (defun ada-wisi-comment ()
1073 "Compute indentation of a comment. For `wisi-indent-calculate-functions'."
1074 ;; We know we are at the first token on a line. We check for comment
1075 ;; syntax, not comment-start, to accomodate gnatprep, skeleton
1076 ;; placeholders, etc.
1077 (when (and (not (= (point) (point-max))) ;; no char after EOB!
1078 (= 11 (syntax-class (syntax-after (point)))))
1080 ;; We are at a comment; indent to previous code or comment.
1082 ((and ada-indent-comment-col-0
1083 (= 0 (current-column)))
1087 (save-excursion (forward-line -1) (looking-at "\\s *$"))
1088 (save-excursion (forward-comment -1)(not (looking-at comment-start))))
1089 ;; comment is after a blank line or code; indent as if code
1091 ;; ada-wisi-before-cache will find the keyword _after_ the
1092 ;; comment, which could be a block-middle or block-end, and that
1093 ;; would align the comment with the block-middle, which is wrong. So
1094 ;; we only call ada-wisi-after-cache.
1096 ;; FIXME: need option to match gnat style check; change indentation to match (ie mod 3)
1097 (ada-wisi-after-cache))
1100 ;; comment is after a comment
1101 (forward-comment -1)
1105 (defun ada-wisi-post-parse-fail ()
1106 "For `wisi-post-parse-fail-hook'."
1108 (let ((start-cache (wisi-goto-start (or (wisi-get-cache (point)) (wisi-backward-cache)))))
1110 ;; nil when in a comment at point-min
1111 (indent-region (point) (wisi-cache-end start-cache)))
1113 (back-to-indentation))
1115 ;;;; ada-mode functions (alphabetical)
1117 (defun ada-wisi-declarative-region-start-p (cache)
1118 "Return t if cache is a keyword starting a declarative region."
1119 (cl-case (wisi-cache-token cache)
1122 (memq (wisi-cache-class cache) '(block-start block-middle)))
1126 (defun ada-wisi-context-clause ()
1127 "For `ada-fix-context-clause'."
1128 (wisi-validate-cache (point-max))
1130 (goto-char (point-min))
1136 (setq cache (wisi-forward-cache))
1137 (cl-case (wisi-cache-nonterm cache)
1142 (setq begin (point-at-bol))))
1144 ;; start of compilation unit
1145 (setq end (point-at-bol))
1152 (defun ada-wisi-goto-declaration-start ()
1153 "For `ada-goto-declaration-start', which see.
1154 Also return cache at start."
1155 (wisi-validate-cache (point))
1156 (let ((cache (wisi-get-cache (point)))
1159 (setq cache (wisi-backward-cache)))
1160 ;; cache is null at bob
1165 (cl-case (wisi-cache-nonterm cache)
1166 ((generic_package_declaration generic_subprogram_declaration)
1167 (eq (wisi-cache-token cache) 'GENERIC))
1169 ((package_body package_declaration)
1170 (eq (wisi-cache-token cache) 'PACKAGE))
1172 ((protected_body protected_type_declaration single_protected_declaration)
1173 (eq (wisi-cache-token cache) 'PROTECTED))
1175 ((subprogram_body subprogram_declaration null_procedure_declaration)
1176 (memq (wisi-cache-token cache) '(NOT OVERRIDING FUNCTION PROCEDURE)))
1178 (task_type_declaration
1179 (eq (wisi-cache-token cache) 'TASK))
1183 (setq cache (wisi-goto-containing cache nil))))
1188 (defun ada-wisi-goto-declaration-end ()
1189 "For `ada-goto-declaration-end', which see."
1190 ;; first goto-declaration-start, so we get the right end, not just
1191 ;; the current statement end.
1192 (wisi-goto-end-1 (ada-wisi-goto-declaration-start)))
1194 (defun ada-wisi-goto-declarative-region-start ()
1195 "For `ada-goto-declarative-region-start', which see."
1196 (wisi-validate-cache (point))
1201 (wisi-get-cache (point))
1202 ;; we use forward-cache here, to handle the case where point is after a subprogram declaration:
1205 ;; function ... is ... end;
1207 ;; function ... is ... end;
1208 (wisi-forward-cache))))
1210 (if (ada-wisi-declarative-region-start-p cache)
1212 (wisi-forward-token t)
1214 (cl-case (wisi-cache-class cache)
1215 ((block-middle block-end)
1216 (setq cache (wisi-prev-statement-cache cache)))
1219 ;; 1) test/ada_mode-nominal.adb
1220 ;; protected body Protected_1 is -- target 2
1224 ;; 2) test/ada_mode-nominal.adb
1225 ;; function Function_Access_1
1226 ;; (A_Param <point> : in Float)
1232 ;; 3) test/ada_mode-nominal-child.adb
1233 ;; overriding <point> function Function_2c (Param : in Child_Type_1)
1235 ;; is -- target Function_2c
1240 (setq cache (wisi-goto-containing cache t))
1242 (cl-case (wisi-cache-nonterm cache)
1244 (while (not (eq 'IS (wisi-cache-token cache)))
1245 (setq cache (wisi-next-statement-cache cache))))
1247 (setq cache (wisi-goto-containing cache t)))
1250 (setq cache (wisi-goto-containing cache t)))
1252 (when first (setq first nil)))
1255 (defun ada-wisi-in-paramlist-p ()
1256 "For `ada-in-paramlist-p'."
1257 (wisi-validate-cache (point))
1258 ;; (info "(elisp)Parser State" "*syntax-ppss*")
1259 (let* ((parse-result (syntax-ppss))
1261 (and (> (nth 0 parse-result) 0)
1262 ;; cache is nil if the parse failed
1263 (setq cache (wisi-get-cache (nth 1 parse-result)))
1264 (eq 'formal_part (wisi-cache-nonterm cache)))
1267 (defun ada-wisi-make-subprogram-body ()
1268 "For `ada-make-subprogram-body'."
1269 (wisi-validate-cache (point))
1270 (when wisi-parse-failed
1271 (error "syntax parse failed; cannot create body"))
1273 (let* ((begin (point))
1274 (end (save-excursion (wisi-forward-find-class 'statement-end (point-max)) (point)))
1275 (cache (wisi-forward-find-class 'name end))
1276 (name (buffer-substring-no-properties
1278 (+ (point) (wisi-cache-last cache)))))
1281 (insert " is begin\nnull;\nend ");; legal syntax; parse does not fail
1285 ;; newline after body to separate from next body
1286 (newline-and-indent)
1287 (indent-region begin (point))
1289 (back-to-indentation); before 'null;'
1292 (defun ada-wisi-scan-paramlist (begin end)
1293 "For `ada-scan-paramlist'."
1294 (wisi-validate-cache end)
1314 (let ((token-text (wisi-forward-token)))
1315 (setq token (nth 0 token-text))
1316 (setq text (nth 1 token-text)))
1318 ((equal token 'COMMA) nil);; multiple identifiers
1320 ((equal token 'COLON)
1321 ;; identifiers done. find type-begin; there may be no mode
1322 (skip-syntax-forward " ")
1323 (setq type-begin (point))
1325 (while (member (car (wisi-forward-token)) '(IN OUT NOT NULL ACCESS CONSTANT PROTECTED))
1326 (skip-syntax-forward " ")
1327 (setq type-begin (point)))))
1329 ((equal token 'IN) (setq in-p t))
1330 ((equal token 'OUT) (setq out-p t))
1331 ((and (not type-end)
1332 (member token '(NOT NULL)))
1333 ;; "not", "null" could be part of the default expression
1334 (setq not-null-p t))
1335 ((equal token 'ACCESS) (setq access-p t))
1336 ((equal token 'CONSTANT) (setq constant-p t))
1337 ((equal token 'PROTECTED) (setq protected-p t))
1339 ((equal token 'COLON_EQUAL)
1340 (setq type-end (save-excursion (backward-char 2) (skip-syntax-backward " ") (point)))
1341 (skip-syntax-forward " ")
1342 (setq default-begin (point))
1343 (wisi-forward-find-token 'SEMICOLON end t))
1345 ((member token '(SEMICOLON RIGHT_PAREN))
1346 (if (equal token 'RIGHT_PAREN)
1350 (when (not type-end) (setq type-end (1- (point))))
1351 (when default-begin (setq default (buffer-substring-no-properties default-begin (1- (point)))))
1353 ;; else semicolon - one param done
1354 (when (not type-end) (setq type-end (1- (point))))
1355 (when default-begin (setq default (buffer-substring-no-properties default-begin (1- (point)))))
1358 (setq type (buffer-substring-no-properties type-begin type-end))
1359 (setq param (list (reverse identifiers)
1360 in-p out-p not-null-p access-p constant-p protected-p
1363 (add-to-list 'paramlist param)
1364 (setq paramlist (list param)))
1365 (setq identifiers nil
1379 (when (not type-begin)
1381 (add-to-list 'identifiers text)
1382 (setq identifiers (list text)))))
1386 (defun ada-wisi-which-function-1 (keyword add-body)
1387 "used in `ada-wisi-which-function'."
1390 (cache (wisi-forward-find-class 'name (point-max))))
1392 (setq result (wisi-cache-text cache))
1394 (when (not ff-function-name)
1395 (setq ff-function-name
1398 (when add-body "\\s-+body")
1404 (defun ada-wisi-which-function ()
1405 "For `ada-which-function'."
1406 (wisi-validate-cache (point))
1409 (cache (ada-wisi-goto-declaration-start)))
1414 (cl-case (wisi-cache-nonterm cache)
1415 ((generic_package_declaration generic_subprogram_declaration)
1416 ;; name is after next statement keyword
1417 (wisi-next-statement-cache cache)
1418 (setq cache (wisi-get-cache (point))))
1421 ;; add or delete 'body' as needed
1422 (cl-ecase (wisi-cache-nonterm cache)
1424 (setq result (ada-wisi-which-function-1 "package" nil)))
1426 ((package_declaration
1427 generic_package_declaration) ;; after 'generic'
1428 (setq result (ada-wisi-which-function-1 "package" t)))
1431 (setq result (ada-wisi-which-function-1 "protected" nil)))
1433 ((protected_type_declaration single_protected_declaration)
1434 (setq result (ada-wisi-which-function-1 "protected" t)))
1436 ((subprogram_declaration
1437 subprogram_specification ;; after 'generic'
1438 null_procedure_declaration)
1439 (setq result (ada-wisi-which-function-1
1440 (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
1441 nil))) ;; no 'body' keyword in subprogram bodies
1444 (setq result (ada-wisi-which-function-1
1445 (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
1448 (task_type_declaration
1449 (setq result (ada-wisi-which-function-1 "task" t)))
1455 (defun ada-wisi-debug-keys ()
1456 "Add debug key definitions to `ada-mode-map'."
1458 (define-key ada-mode-map "\M-e" 'wisi-show-parse-error)
1459 (define-key ada-mode-map "\M-h" 'wisi-show-containing-or-previous-cache)
1460 (define-key ada-mode-map "\M-i" 'wisi-goto-end)
1461 (define-key ada-mode-map "\M-j" 'wisi-show-cache)
1462 (define-key ada-mode-map "\M-k" 'wisi-show-token)
1465 (defun ada-wisi-setup ()
1466 "Set up a buffer for parsing Ada files with wisi."
1467 (wisi-setup '(ada-wisi-comment
1468 ada-wisi-before-cache
1469 ada-wisi-after-cache)
1470 'ada-wisi-post-parse-fail
1472 ada-grammar-wy--keyword-table
1473 ada-grammar-wy--token-table
1474 ada-grammar-wy--parse-table)
1476 ;; Handle escaped quotes in strings
1477 (setq wisi-string-quote-escape-doubled t)
1479 ;; Handle bracket notation for non-ascii characters in strings. This
1480 ;; is actually more forgiving than that; it will treat
1481 ;; '"foo["bar"]baz" as a single string. But that will be caught by
1482 ;; the compiler, so it's ok for us.
1483 (setq wisi-string-quote-escape '(?\" . ?\[ ))
1485 (set (make-local-variable 'comment-indent-function) 'wisi-comment-indent)
1487 (add-hook 'hack-local-variables-hook 'ada-wisi-post-local-vars nil t)
1490 (defun ada-wisi-post-local-vars ()
1491 ;; run after file local variables are read because font-lock-add-keywords
1492 ;; evaluates font-lock-defaults, which depends on ada-language-version.
1493 (font-lock-add-keywords 'ada-mode
1494 ;; use keyword cache to distinguish between 'function ... return <type>;' and 'return ...;'
1499 "return[ \t]+access[ \t]+constant\\|"
1500 "return[ \t]+access\\|"
1503 ada-name-regexp "?")
1504 '(1 font-lock-keyword-face)
1505 '(2 (if (eq (when (not (ada-in-string-or-comment-p))
1506 (wisi-validate-cache (match-end 2))
1507 (and (wisi-get-cache (match-beginning 2))
1508 (wisi-cache-class (wisi-get-cache (match-beginning 2)))))
1515 (when global-font-lock-mode
1516 ;; ensure the modified keywords are applied
1517 (font-lock-refresh-defaults))
1520 (add-hook 'ada-mode-hook 'ada-wisi-setup)
1522 (setq ada-fix-context-clause 'ada-wisi-context-clause)
1523 (setq ada-goto-declaration-start 'ada-wisi-goto-declaration-start)
1524 (setq ada-goto-declaration-end 'ada-wisi-goto-declaration-end)
1525 (setq ada-goto-declarative-region-start 'ada-wisi-goto-declarative-region-start)
1526 (setq ada-goto-end 'wisi-goto-end)
1527 (setq ada-in-paramlist-p 'ada-wisi-in-paramlist-p)
1528 (setq ada-indent-statement 'wisi-indent-statement)
1529 (setq ada-make-subprogram-body 'ada-wisi-make-subprogram-body)
1530 (setq ada-next-statement-keyword 'wisi-forward-statement-keyword)
1531 (setq ada-prev-statement-keyword 'wisi-backward-statement-keyword)
1532 (setq ada-reset-parser 'wisi-invalidate-cache)
1533 (setq ada-scan-paramlist 'ada-wisi-scan-paramlist)
1534 (setq ada-show-parse-error 'wisi-show-parse-error)
1535 (setq ada-which-function 'ada-wisi-which-function)
1538 (provide 'ada-indent-engine)