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, 2013 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 ;; not using lexical-binding or cl-lib because we support Emacs 23
34 (require 'ada-fix-error)
35 (require 'ada-grammar-wy)
36 (require 'ada-indent-user-options)
39 (eval-when-compile (require 'cl-macs))
41 (defconst ada-wisi-class-list
44 block-middle ;; not start of statement
45 block-start ;; start of block is start of statement
49 name-paren ;; anything that looks like a procedure call, since the grammar can't distinguish most of them
62 (defun ada-wisi-indent-cache (offset cache)
63 "Return indentation of OFFSET plus indentation of line containing point. Point must be at CACHE."
64 (let ((indent (current-indentation)))
68 ((eq 'LEFT_PAREN (wisi-cache-token cache))
69 ;; test/ada_mode-long_paren.adb
73 ;; (RX_Torque_Subaddress |
76 ;; test/ada_mode-parens.adb
80 ;; indenting '(local_6)'; 'offset' = ada-indent - 1
81 (+ (current-column) 1 offset))
84 (let ((containing (wisi-goto-containing-paren cache)))
86 ;; test/ada_mode-conditional_expressions.adb
87 ;; K2 : Integer := (if J > 42
89 ;; indenting 'then'; offset = 0
91 ;; need get-start, not just get-containing, because of:
92 ;; L1 : Integer := (case J is
95 ;; _not_ (ada-in-paren-p), because of:
97 ;; C_S_Controls : constant
101 ;; 1 => -- Used to be aligned on "CSCL_Type'"
102 ;; -- aligned with previous comment.
103 ;; IO_CPU_Control_State_S_Pkg.CPU2_Fault_Status_Type'
104 ;; (Unused2 => 10, -- Used to be aligned on "1 =>"
105 ;; indenting '(Unused2'
106 (+ (current-column) offset)))))
108 ;; all other structures
110 ;; current cache may be preceded by something on same
111 ;; line. Handle common cases nicely.
114 (not (= (current-column) indent))
115 (eq 'EQUAL_GREATER (wisi-cache-token cache))))
117 (eq 'WHEN (wisi-cache-token cache))
118 (not (eq 'exit_statement (wisi-cache-nonterm cache))))
119 (setq offset (+ offset ada-indent-when)))
120 (setq cache (wisi-goto-containing cache))
121 (setq indent (current-indentation)))
125 ;; test/ada_mode-opentoken.ads
126 ;; private package GDS.Commands.Add_Statement is
127 ;; type Instance is new Nonterminal.Instance with null record;
130 ((eq 'label_opt (wisi-cache-token cache))
131 (+ indent (- ada-indent-label) offset))
134 ;; test/ada_mode-generic_instantiation.ads
135 ;; function Function_1 is new Instance.Generic_Function
136 ;; (Param_Type => Integer,
138 ;; test/ada_mode-nested_packages.adb
139 ;; function Create (Model : in Integer;
140 ;; Context : in String) return String is
142 ;; Cache : array (1 .. 10) of Boolean := (True, False, others => False);
147 (defun ada-wisi-indent-containing (offset cache &optional before)
148 "Return indentation of OFFSET plus indentation of token containing CACHE.
149 BEFORE should be t when called from ada-wisi-before-cache, nil otherwise."
152 ((markerp (wisi-cache-containing cache))
153 (ada-wisi-indent-cache offset (wisi-goto-containing cache)))
158 (ada-goto-open-paren 1)
159 (+ (current-column) offset))
162 ;; at outermost containing statement. If called from
163 ;; ada-wisi-before-cache, we want to ignore OFFSET (indenting
164 ;; 'package' in a package spec). If called from
165 ;; ada-wisi-after-cache, we want to include offset (indenting
166 ;; first declaration in the package).
167 (if before 0 offset))
171 (defun ada-wisi-before-cache ()
172 "Point is at indentation, before a cached token. Return new indentation for point."
173 (let ((pos-0 (point))
174 (cache (wisi-get-cache (point))))
176 (cl-ecase (wisi-cache-class cache)
178 (cl-case (wisi-cache-token cache)
179 (IS ;; subprogram body
180 (ada-wisi-indent-containing 0 cache t))
183 (ada-wisi-indent-containing ada-indent-record-rel-type cache t))
186 (ada-wisi-indent-containing ada-indent cache t))))
189 (cl-case (wisi-cache-nonterm cache)
192 (wisi-goto-containing cache);; now on 'record'
193 (current-indentation)))
196 (ada-wisi-indent-containing 0 cache t))
200 (cl-case (wisi-cache-token cache)
202 (ada-wisi-indent-containing ada-indent-when cache t))
205 (ada-wisi-indent-containing 0 cache t))
208 (close-paren (wisi-indent-paren 0))
211 (ada-wisi-indent-containing ada-indent-broken cache t))
214 (let ((containing (wisi-goto-containing cache)))
215 (cl-case (wisi-cache-class containing)
217 ;; test/ada_mode-slices.adb
218 ;; Put_Line(Day'Image(D1) & " - " & Day'Image(D2) & " = " &
219 ;; Integer'Image(N));
221 ;; test/ada_mode-parens.adb
224 ;; indenting 'Integer'
226 ;; We distinguish the two cases by going to the first token,
227 ;; and comparing point to pos-0.
228 (let ((paren-column (current-column)))
229 (wisi-forward-token t); "("
230 (forward-comment (point-max))
231 (if (= (point) pos-0)
235 (+ paren-column 1 ada-indent-broken))))
239 ;; Append_To (Formals,
240 ;; Make_Parameter_Specification (Loc,
241 (wisi-indent-paren 1))
244 ;; test/ada_mode-generic_instantiation.ads
245 ;; procedure Procedure_6 is new
246 ;; Instance.Generic_Procedure (Integer, Function_1);
247 ;; indenting 'Instance'; containing is 'new'
248 (ada-wisi-indent-cache ada-indent-broken containing))
252 (let ((containing (wisi-goto-containing cache)))
253 (cl-case (wisi-cache-token containing)
255 ;; test/ada_mode-parens.adb
256 ;; A : Matrix_Type :=
260 (ada-wisi-indent-containing 0 containing))
263 (setq containing (wisi-goto-containing containing))
264 (cl-ecase (wisi-cache-token containing)
266 ;; test/ada_mode-long_paren.adb
270 ;; (RX_Torque_Subaddress |
271 ;; indenting (RX_Torque
272 (ada-wisi-indent-containing (1- ada-indent) containing t))
274 ;; test/ada_mode-parens.adb
277 ;; indenting '(1 => 12'; containing is '=>'
278 (ada-wisi-indent-cache (1- ada-indent) containing))
280 ;; test/ada_mode-conditional_expressions.adb
283 ;; indenting '(if'; containing is '=>'
284 (+ (current-column) -1 ada-indent))
287 ((FUNCTION PROCEDURE)
288 ;; test/ada_mode-nominal.adb
289 ;; function Function_Access_11
290 ;; (A_Param : in Float)
291 ;; -- EMACSCMD:(test-face "function" font-lock-keyword-face)
292 ;; return access function
293 ;; (A_Param : in Float)
295 ;; Standard.Float -- Ada mode 4.01, GPS do this differently
296 ;; indenting second '(A_Param)
297 (+ (current-indentation) -1 ada-indent))
300 ;; test/ada_mode-parens.adb
306 (+ (current-column) 1 ada-indent-broken))
314 ;; test/ada_mode-parens.adb
321 (+ (current-indentation) ada-indent-broken))
325 ((memq (wisi-cache-class containing) '(block-start statement-start))
326 ;; test/ada_mode-nominal.adb
330 (ada-wisi-indent-cache ada-indent-broken containing))
333 (eq (wisi-cache-nonterm containing) 'entry_body)
334 (eq (wisi-cache-token containing) 'WHEN))
335 ;; test/ada_mode-nominal.adb
336 ;; when Local_1 = 0 and not
338 ;; indenting (Local_2
339 (+ (current-column) ada-indent-broken))
342 ;; Open paren in an expression.
344 ;; test/ada_mode-conditional_expressions.adb
346 ;; (case J is when 42 => -1, when Integer'First .. 41 => 0, when others => 1);
348 (ada-wisi-indent-containing ada-indent-broken containing t))
352 (return-1;; parameter list
353 (let ((return-pos (point)))
354 (wisi-goto-containing cache nil) ;; matching 'function'
356 ((<= ada-indent-return 0)
357 ;; indent relative to "("
358 (wisi-forward-find-class 'open-paren return-pos)
359 (+ (current-column) (- ada-indent-return)))
362 (+ (current-column) ada-indent-return))
365 (return-2;; no parameter list
366 (wisi-goto-containing cache nil) ;; matching 'function'
367 (+ (current-column) ada-indent-broken))
370 (ada-wisi-indent-containing ada-indent-broken cache t))
373 (let ((containing (wisi-goto-containing cache nil)))
374 (cl-case (wisi-cache-token cache)
376 (+ (current-column) ada-indent-broken))
380 ;; elsif Current_Argument < CL.Argument_Count then
381 (ada-wisi-indent-cache 0 containing))
384 (cl-ecase (wisi-cache-nonterm containing)
385 ((generic_renaming_declaration subprogram_renaming_declaration)
386 (wisi-forward-find-token '(FUNCTION PROCEDURE) pos-0)
387 (let ((pos-subprogram (point))
389 ;; this is wrong for one return access
390 ;; function case: overriding function Foo
391 ;; return access Bar (...) renames ...;
392 (wisi-forward-find-token 'LEFT_PAREN pos-0 t)))
394 (if (<= ada-indent-renames 0)
395 ;; indent relative to paren
396 (+ (current-column) (- ada-indent-renames))
397 ;; else relative to line containing keyword
398 (goto-char pos-subprogram)
399 (+ (current-indentation) ada-indent-renames))
402 (goto-char pos-subprogram)
403 (+ (current-indentation) ada-indent-broken))
406 (object_renaming_declaration
407 (+ (current-indentation) ada-indent-broken))
411 (while (not (wisi-cache-nonterm containing))
412 (setq containing (wisi-goto-containing containing)))
414 (cl-ecase (wisi-cache-nonterm containing)
417 (+ (current-column) 1))
421 ;; 1 => -- Used to be aligned on "CSCL_Type'"
422 ;; -- aligned with previous comment.
423 ;; IO_CPU_Control_State_S_Pkg.CPU2_Fault_Status_Type'
424 (ada-wisi-indent-cache ada-indent-broken containing))
428 (+ (current-column) ada-indent-broken))
430 (component_declaration
431 ;; test/ada_mode-nominal.ads record_type_3
432 (+ (current-column) ada-indent-broken))
436 (+ (current-column) ada-indent-broken))
438 (formal_package_declaration
439 ;; test/ada_mode-generic_package.ads
440 ;; with package A_Package_7 is
441 ;; new Ada.Text_IO.Integer_IO (Num => Formal_Signed_Integer_Type);
443 (+ (current-column) ada-indent-broken))
445 (full_type_declaration
446 ;; test/ada_mode-nominal.ads
447 ;; type Unconstrained_Array_Type_3 is array (Integer range <>, Standard.Character range <>)
448 ;; of Object_Access_Type_1;
451 ;; type Object_Access_Type_7
452 ;; is access all Integer;
454 (while (not (eq 'TYPE (wisi-cache-token containing)))
455 (setq containing (wisi-goto-containing containing)))
456 (+ (current-column) ada-indent-broken))
458 (generic_instantiation
459 ;; test/ada_mode-generic_instantiation.ads
460 ;; procedure Procedure_7 is
461 ;; new Instance.Generic_Procedure (Integer, Function_1);
463 (+ (current-column) ada-indent-broken))
465 (generic_renaming_declaration
466 ;; indenting keyword following 'generic'
470 (cl-ecase (wisi-cache-token containing)
472 ;; test/ada_mode-nominal.ads
473 ;; Anon_Array_3 : array (1 .. 10)
476 (+ (current-indentation) ada-indent-broken))
480 ;; C_S_Controls : constant
483 ;; indenting 'CSCL_Type'
484 (+ (current-indentation) ada-indent-broken))
487 ;; test/ada_mode-nominal.adb
488 ;; Local_2 : constant Float
490 (+ (current-indentation) ada-indent-broken))
493 (qualified_expression
494 ;; test/ada_mode-nominal-child.ads
495 ;; Child_Obj_5 : constant Child_Type_1 :=
497 ;; (Parent_Element_1 => 1,
498 (ada-wisi-indent-cache ada-indent-broken containing))
501 (cl-case (wisi-cache-token containing)
503 (- (current-column) ada-indent-label))
506 ;; test/ada_mode-nominal.adb
512 (ada-wisi-indent-cache ada-indent-broken cache))
515 ((subprogram_body subprogram_declaration subprogram_specification null_procedure_declaration)
516 (cl-ecase (wisi-cache-token cache)
518 ;; indenting 'overriding' following 'not'
521 ((PROCEDURE FUNCTION)
522 ;; indenting 'procedure' or 'function following 'overriding'
527 ;; test/adacore_9717_001.ads A_Long_Name
528 (+ (current-column) ada-indent-broken))
530 ))))) ;; end statement-other
534 ((eq 'label_opt (wisi-cache-token cache))
535 (ada-wisi-indent-containing (+ ada-indent-label ada-indent) cache t))
538 (let ((containing-cache (wisi-get-containing-cache cache)))
539 (if (not containing-cache)
543 (cl-case (wisi-cache-class containing-cache)
544 ((block-start block-middle)
545 (wisi-goto-containing cache)
546 (cl-case (wisi-cache-nonterm containing-cache)
548 (+ (current-indentation) ada-indent))
551 (ada-wisi-indent-cache ada-indent containing-cache))
555 ;; test/ada_mode-generic_instantiation.ads
556 ;; function Function_1 is new Instance.Generic_Function
557 ;; (Param_Type => Integer,
558 ;; Result_Type => Boolean,
560 ;; indenting 'Result_Type'
561 (wisi-indent-paren 1))
564 (cl-case (wisi-cache-token containing-cache)
566 ;; test/ada_mode-parens.adb
569 ;; indenting 'Integer'
570 (wisi-indent-paren 1))
573 ;; test/ada_mode-nested_packages.adb
575 ;; when Io.Name_Error =>
577 (ada-wisi-indent-containing ada-indent containing-cache t))
580 ;; test/ada_mode-generic_instantiation.ads
581 ;; procedure Procedure_6 is new
582 ;; Instance.Generic_Procedure (Integer, Function_1);
583 ;; indenting 'Instance'
584 (ada-wisi-indent-containing ada-indent-broken cache t))
590 (ada-wisi-indent-containing ada-indent-broken cache t))
594 (defun ada-wisi-after-cache ()
595 "Point is at indentation, not before a cached token. Find previous
596 cached token, return new indentation for point."
597 (let ((start (point))
598 (prev-token (save-excursion (wisi-backward-token)))
599 (cache (wisi-backward-cache)))
606 (while (memq (wisi-cache-class cache) '(name name-paren type))
607 ;; not useful for indenting
608 (setq cache (wisi-backward-cache)))
610 (cl-ecase (wisi-cache-class cache)
612 ;; indenting block/subprogram name after 'end'
613 (wisi-indent-current ada-indent-broken))
616 (cl-case (wisi-cache-token cache)
618 (cl-case (wisi-cache-nonterm cache)
620 ;; between 'case .. is' and first 'when'; most likely a comment
621 (ada-wisi-indent-containing 0 cache t))
624 (+ (ada-wisi-indent-containing ada-indent cache t)))
629 (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
630 ((statement if_statement elsif_statement_item) ada-indent)
631 ((if_expression elsif_expression_item) ada-indent-broken))))
632 (ada-wisi-indent-containing indent cache t)))
635 ;; between 'when' and '=>'
636 (+ (current-column) ada-indent-broken))
639 ;; block-middle keyword may not be on separate line:
640 ;; function Create (Model : in Integer;
641 ;; Context : in String) return String is
642 (ada-wisi-indent-containing ada-indent cache nil))
646 (cl-case (wisi-cache-nonterm cache)
648 ;; between 'when' and '=>'
649 (+ (current-column) ada-indent-broken))
652 (ada-wisi-indent-containing ada-indent-broken cache nil))
655 (ada-wisi-indent-containing (+ ada-indent-when ada-indent-broken) cache nil))
657 (t ;; other; normal block statement
658 (ada-wisi-indent-cache ada-indent cache))
662 ;; actual_parameter_part: test/ada_mode-nominal.adb
664 ;; Foo (Bar) + -- multi-line expression that happens to have a cache at a line start
666 ;; indenting '12'; don't indent relative to containing function name
668 ;; attribute_designator: test/ada_mode-nominal.adb
669 ;; raise Constraint_Error with Count'Image (Line (File)) &
671 ;; indenting '"foo"'; relative to raise
672 (when (memq (wisi-cache-nonterm cache)
673 '(actual_parameter_part attribute_designator))
674 (setq cache (wisi-goto-containing cache)))
675 (ada-wisi-indent-containing ada-indent-broken cache nil))
679 (let ((break-point (point))
680 (containing (wisi-goto-containing cache)))
681 (cl-ecase (wisi-cache-token containing)
684 ((list-element-token (wisi-cache-token (save-excursion (wisi-forward-cache))))
686 (cl-case list-element-token
687 (WHEN ada-indent-when)
689 (if (equal break-point (cl-caddr prev-token))
690 ;; we are indenting the first token after the list-break; not hanging.
691 (+ (current-column) 1 indent)
693 (+ (current-column) 1 ada-indent-broken indent))))
696 ;; ada_mode-conditional_expressions.adb
697 ;; L1 : Integer := (case J is
699 ;; -- comment aligned with 'when'
700 ;; indenting '-- comment'
701 (wisi-indent-paren (+ 1 ada-indent-when)))
704 (cl-ecase (wisi-cache-nonterm containing)
706 ;; ada_mode-nominal-child.ads
707 ;; (Default_Parent with
708 ;; Child_Element_1 => 10,
709 ;; Child_Element_2 => 12.0,
710 (wisi-indent-paren 1))
715 ;; 1) A parenthesized expression, or the first item in an aggregate:
722 ;; we are indenting 'bar'
724 ;; 2) A parenthesized expression, or the first item in an
725 ;; aggregate, and there is whitespace between
726 ;; ( and the first token:
728 ;; test/ada_mode-parens.adb
729 ;; Local_9 : String := (
732 ;; 3) A parenthesized expression, or the first item in an
733 ;; aggregate, and there is a comment between
734 ;; ( and the first token:
736 ;; test/ada_mode-nominal.adb
739 ;; -- a comment between paren and first association
742 (let ((paren-column (current-column))
743 (start-is-comment (save-excursion (goto-char start) (looking-at comment-start-skip))))
744 (wisi-forward-token t); point is now after paren
746 (skip-syntax-forward " >"); point is now on comment
747 (forward-comment (point-max)); point is now on first token
749 (if (= (point) start)
753 (+ paren-column 1 ada-indent-broken))))
756 ;; hanging. Intent relative to line containing matching 'function'
757 (ada-prev-statement-keyword)
758 (back-to-indentation)
759 (+ (current-column) ada-indent-broken))
762 (ada-wisi-indent-containing 0 cache nil))
765 (cl-ecase (wisi-cache-token cache)
771 ;; -- 'abort' indented with ada-broken-indent, since this is part
773 (ada-wisi-indent-containing ada-indent cache))
775 ;; test/subdir/ada_mode-separate_task_body.adb
777 ;; Local_3 : constant Float :=
779 (ada-wisi-indent-cache ada-indent-broken cache))
782 (cl-ecase (wisi-cache-nonterm cache)
784 (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache))
786 ;; test/with_use1.adb
787 (ada-wisi-indent-containing ada-indent-use cache))
790 ;; test/ada_mode-nominal.ads
791 ;; limited private with Ada.Strings.Bounded,
792 ;; --EMACSCMD:(test-face "Ada.Containers" 'default)
795 ;; test/with_use1.adb
796 (ada-wisi-indent-containing ada-indent-with cache))
802 ;; elsif Index_Switches + Max_Length <= Switches'Last
803 ;; and then Switches (Index_Switches + Max_Length) = '?'
804 (ada-wisi-indent-cache ada-indent-broken cache))
807 (cl-ecase (wisi-cache-nonterm (wisi-goto-containing cache nil))
808 (actual_parameter_part
809 ;; ada_mode-generic_package.ads
810 ;; with package A_Package_2 is new Ada.Text_IO.Integer_IO (Num =>
811 ;; Formal_Signed_Integer_Type);
812 ;; indenting 'Formal_Signed_...', point on '(Num'
813 (+ (current-column) 1 ada-indent-broken))
816 ;; test/ada_mode-parens.adb
821 (wisi-indent-paren (1+ ada-indent-broken)))
823 ((case_expression_alternative case_statement_alternative exception_handler)
824 ;; containing is 'when'
825 (+ (current-column) ada-indent))
827 (generic_renaming_declaration
828 ;; not indenting keyword following 'generic'
829 (+ (current-column) ada-indent-broken))
832 ;; test/ada_mode-quantified_expressions.adb
833 ;; if (for some J in 1 .. 10 =>
835 (ada-wisi-indent-containing ada-indent-broken cache))
840 (setq cache (wisi-goto-containing cache))
841 (cl-ecase (wisi-cache-nonterm cache)
842 (full_type_declaration
843 ;; ada_mode/nominal.ads
844 ;; type Limited_Derived_Type_1a is abstract limited new
845 ;; Private_Type_1 with record
846 ;; Component_1 : Integer;
847 ;; indenting 'Private_Type_1'; look for 'record'
848 (let ((type-column (current-column)))
850 (if (wisi-forward-find-token 'RECORD (line-end-position) t)
851 ;; 'record' on line being indented
852 (+ type-column ada-indent-record-rel-type)
853 ;; 'record' on later line
854 (+ type-column ada-indent-broken))))
856 ((formal_type_declaration
857 ;; test/ada_mode-generic_package.ads
858 ;; type Synchronized_Formal_Derived_Type is abstract synchronized new Formal_Private_Type and Interface_Type
862 ;; test/ada_mode-nominal.ads
863 ;; subtype Subtype_2 is Signed_Integer_Type range 10 ..
866 (+ (current-column) ada-indent-broken))
871 ;; C_S_Controls : constant
876 (+ (current-column) 1))
879 ;; ada_mode-nominal.ads
880 ;; Anon_Array_2 : array (1 .. 10) of
882 (ada-wisi-indent-containing ada-indent-broken cache))
885 ;; ada_mode-nominal.ads
886 ;; type Limited_Derived_Type_2 is abstract limited new Private_Type_1 with
888 (ada-wisi-indent-containing ada-indent-broken cache))
891 ;; test/ada_mode-parens.adb
894 (ada-wisi-indent-containing ada-indent-broken cache))
897 ;; extension aggregate: test/ada_mode-nominal-child.ads
898 ;; (Default_Parent with
900 ;; indenting '10'; containing is '('
902 ;; raise_statement: test/ada_mode-nominal.adb
903 ;; raise Constraint_Error with
905 (cl-case (wisi-cache-nonterm cache)
907 (ada-wisi-indent-containing 0 cache nil))
909 (ada-wisi-indent-containing ada-indent-broken cache nil))
912 ;; otherwise just hanging
913 ((ACCEPT FUNCTION PROCEDURE RENAMES)
914 (back-to-indentation)
915 (+ (current-column) ada-indent-broken))
920 (cl-case (wisi-cache-token cache)
922 (+ (current-column) ada-indent-with))
925 ;; comment after label
926 (+ (current-column) (- ada-indent-label)))
929 ;; procedure Procedure_8
930 ;; is new Instance.Generic_Procedure (Integer, Function_1);
931 ;; indenting 'is'; hanging
932 ;; (+ (current-column) ada-indent-broken))
933 (ada-wisi-indent-cache ada-indent-broken cache))
938 (defun ada-wisi-comment ()
939 "Compute indentation of a comment. For `wisi-indent-functions'."
940 ;; We know we are at the first token on a line. We check for comment
941 ;; syntax, not comment-start, to accomodate gnatprep, skeleton
942 ;; placeholders, etc.
943 (when (= 11 (syntax-class (syntax-after (point))))
945 ;; We are at a comment; indent to previous code or comment.
947 ((and ada-indent-comment-col-0
948 (= 0 (current-column)))
952 (save-excursion (forward-line -1) (looking-at "\\s *$"))
953 (save-excursion (forward-comment -1)(not (looking-at comment-start))))
954 ;; comment is after a blank line or code; indent as if code
956 ;; ada-wisi-before-cache will find the keyword _after_ the
957 ;; comment, which could be a block-middle or block-end, and that
958 ;; would align the comment with the block-middle, which is wrong. So
959 ;; we only call ada-wisi-after-cache.
961 ;; FIXME: need option to match gnat style check; change indentation to match (ie mod 3)
962 (ada-wisi-after-cache))
965 ;; comment is after a comment
970 (defun ada-wisi-post-parse-fail ()
971 "For `wisi-post-parse-fail-hook'."
973 (let ((start-cache (wisi-goto-start (or (wisi-get-cache (point)) (wisi-backward-cache)))))
975 ;; nil when in a comment at point-min
976 (indent-region (point) (wisi-cache-end start-cache)))
978 (back-to-indentation))
980 ;;;; ada-mode functions (alphabetical)
982 (defun ada-wisi-declarative-region-start-p (cache)
983 "Return t if cache is a keyword starting a declarative region."
984 (cl-case (wisi-cache-token cache)
987 (memq (wisi-cache-class cache) '(block-start block-middle)))
991 (defun ada-wisi-context-clause ()
992 "For `ada-fix-context-clause'."
993 (wisi-validate-cache (point-max))
995 (goto-char (point-min))
1001 (setq cache (wisi-forward-cache))
1002 (cl-case (wisi-cache-nonterm cache)
1007 (setq begin (point-at-bol))))
1009 ;; start of compilation unit
1010 (setq end (point-at-bol))
1017 (defun ada-wisi-goto-declaration-start ()
1018 "For `ada-goto-declaration-start', which see.
1019 Also return cache at start."
1020 (wisi-validate-cache (point))
1021 (let ((cache (wisi-get-cache (point)))
1024 (setq cache (wisi-backward-cache)))
1025 ;; cache is null at bob
1030 (cl-case (wisi-cache-nonterm cache)
1031 ((generic_package_declaration generic_subprogram_declaration)
1032 (eq (wisi-cache-token cache) 'GENERIC))
1034 ((package_body package_declaration)
1035 (eq (wisi-cache-token cache) 'PACKAGE))
1037 ((protected_body protected_type_declaration single_protected_declaration)
1038 (eq (wisi-cache-token cache) 'PROTECTED))
1040 ((subprogram_body subprogram_declaration null_procedure_declaration)
1041 (memq (wisi-cache-token cache) '(NOT OVERRIDING FUNCTION PROCEDURE)))
1043 (task_type_declaration
1044 (eq (wisi-cache-token cache) 'TASK))
1048 (setq cache (wisi-goto-containing cache nil))))
1053 (defun ada-wisi-goto-declarative-region-start ()
1054 "For `ada-goto-declarative-region-start', which see."
1055 (wisi-validate-cache (point))
1060 (wisi-get-cache (point))
1061 ;; we use forward-cache here, to handle the case where point is after a subprogram declaration:
1064 ;; function ... is ... end;
1066 ;; function ... is ... end;
1067 (wisi-forward-cache))))
1069 (if (ada-wisi-declarative-region-start-p cache)
1071 (wisi-forward-token t)
1073 (cl-case (wisi-cache-class cache)
1074 ((block-middle block-end)
1075 (setq cache (wisi-prev-statement-cache cache)))
1078 ;; 1) test/ada_mode-nominal.adb
1079 ;; protected body Protected_1 is -- target 2
1083 ;; 2) test/ada_mode-nominal.adb
1084 ;; function Function_Access_1
1085 ;; (A_Param <point> : in Float)
1091 ;; 3) test/ada_mode-nominal-child.adb
1092 ;; overriding <point> function Function_2c (Param : in Child_Type_1)
1094 ;; is -- target Function_2c
1099 (setq cache (wisi-goto-containing cache t))
1101 (cl-case (wisi-cache-nonterm cache)
1103 (while (not (eq 'IS (wisi-cache-token cache)))
1104 (setq cache (wisi-next-statement-cache cache))))
1106 (setq cache (wisi-goto-containing cache t)))
1109 (setq cache (wisi-goto-containing cache t)))
1111 (when first (setq first nil)))
1114 (defun ada-wisi-in-paramlist-p ()
1115 "For `ada-in-paramlist-p'."
1116 (wisi-validate-cache (point))
1117 ;; (info "(elisp)Parser State" "*syntax-ppss*")
1118 (let* ((parse-result (syntax-ppss))
1120 (and (> (nth 0 parse-result) 0)
1121 ;; cache is nil if the parse failed
1122 (setq cache (wisi-get-cache (nth 1 parse-result)))
1123 (eq 'formal_part (wisi-cache-nonterm cache)))
1126 (defun ada-wisi-make-subprogram-body ()
1127 "For `ada-make-subprogram-body'."
1128 (wisi-validate-cache (point))
1129 (when wisi-parse-failed
1130 (error "syntax parse failed; cannot create body"))
1132 (let* ((begin (point))
1133 (end (save-excursion (wisi-forward-find-class 'statement-end (point-max)) (point)))
1134 (cache (wisi-forward-find-class 'name end))
1135 (name (buffer-substring-no-properties
1137 (+ (point) (wisi-cache-last cache)))))
1140 (insert " is begin\nnull;\nend ");; legal syntax; parse does not fail
1144 ;; newline after body to separate from next body
1145 (newline-and-indent)
1146 (indent-region begin (point))
1148 (back-to-indentation); before 'null;'
1151 (defun ada-wisi-scan-paramlist (begin end)
1152 "For `ada-scan-paramlist'."
1153 (wisi-validate-cache end)
1173 (let ((token-text (wisi-forward-token)))
1174 (setq token (nth 0 token-text))
1175 (setq text (nth 1 token-text)))
1177 ((equal token 'COMMA) nil);; multiple identifiers
1179 ((equal token 'COLON)
1180 ;; identifiers done. find type-begin; there may be no mode
1181 (skip-syntax-forward " ")
1182 (setq type-begin (point))
1184 (while (member (car (wisi-forward-token)) '(IN OUT NOT NULL ACCESS CONSTANT PROTECTED))
1185 (skip-syntax-forward " ")
1186 (setq type-begin (point)))))
1188 ((equal token 'IN) (setq in-p t))
1189 ((equal token 'OUT) (setq out-p t))
1190 ((and (not type-end)
1191 (member token '(NOT NULL)))
1192 ;; "not", "null" could be part of the default expression
1193 (setq not-null-p t))
1194 ((equal token 'ACCESS) (setq access-p t))
1195 ((equal token 'CONSTANT) (setq constant-p t))
1196 ((equal token 'PROTECTED) (setq protected-p t))
1198 ((equal token 'COLON_EQUAL)
1199 (setq type-end (save-excursion (backward-char 2) (skip-syntax-backward " ") (point)))
1200 (skip-syntax-forward " ")
1201 (setq default-begin (point))
1202 (wisi-forward-find-token 'SEMICOLON end t))
1204 ((member token '(SEMICOLON RIGHT_PAREN))
1205 (if (equal token 'RIGHT_PAREN)
1209 (when (not type-end) (setq type-end (1- (point))))
1210 (when default-begin (setq default (buffer-substring-no-properties default-begin (1- (point)))))
1212 ;; else semicolon - one param done
1213 (when (not type-end) (setq type-end (1- (point))))
1214 (when default-begin (setq default (buffer-substring-no-properties default-begin (1- (point)))))
1217 (setq type (buffer-substring-no-properties type-begin type-end))
1218 (setq param (list (reverse identifiers)
1219 in-p out-p not-null-p access-p constant-p protected-p
1222 (add-to-list 'paramlist param)
1223 (setq paramlist (list param)))
1224 (setq identifiers nil
1238 (when (not type-begin)
1240 (add-to-list 'identifiers text)
1241 (setq identifiers (list text)))))
1245 (defun ada-wisi-which-function-1 (keyword add-body)
1246 "used in `ada-wisi-which-function'."
1249 (cache (wisi-forward-find-class 'name (point-max))))
1251 (setq result (wisi-cache-text cache))
1253 (when (not ff-function-name)
1254 (setq ff-function-name
1257 (when add-body "\\s-+body")
1263 (defun ada-wisi-which-function ()
1264 "For `ada-which-function'."
1265 (wisi-validate-cache (point))
1268 (cache (ada-wisi-goto-declaration-start)))
1273 (cl-case (wisi-cache-nonterm cache)
1274 ((generic_package_declaration generic_subprogram_declaration)
1275 ;; name is after next statement keyword
1276 (wisi-next-statement-cache cache)
1277 (setq cache (wisi-get-cache (point))))
1280 ;; add or delete 'body' as needed
1281 (cl-ecase (wisi-cache-nonterm cache)
1283 (setq result (ada-wisi-which-function-1 "package" nil)))
1285 ((package_declaration
1286 generic_package_declaration) ;; after 'generic'
1287 (setq result (ada-wisi-which-function-1 "package" t)))
1290 (setq result (ada-wisi-which-function-1 "protected" nil)))
1292 ((protected_type_declaration single_protected_declaration)
1293 (setq result (ada-wisi-which-function-1 "protected" t)))
1295 ((subprogram_declaration
1296 subprogram_specification ;; after 'generic'
1297 null_procedure_declaration)
1298 (setq result (ada-wisi-which-function-1
1299 (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
1300 nil))) ;; no 'body' keyword in subprogram bodies
1303 (setq result (ada-wisi-which-function-1
1304 (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max)))
1307 (task_type_declaration
1308 (setq result (ada-wisi-which-function-1 "task" t)))
1314 (defun ada-wisi-debug-keys ()
1315 "Add debug key definitions to `ada-mode-map'."
1317 (define-key ada-mode-map "\M-e" 'wisi-show-parse-error)
1318 (define-key ada-mode-map "\M-h" 'wisi-show-containing-or-previous-cache)
1319 (define-key ada-mode-map "\M-i" 'wisi-goto-end)
1320 (define-key ada-mode-map "\M-j" 'wisi-show-cache)
1321 (define-key ada-mode-map "\M-k" 'wisi-show-token)
1324 (defun ada-wisi-setup ()
1325 "Set up a buffer for parsing Ada files with wisi."
1326 (wisi-setup '(ada-wisi-comment
1327 ada-wisi-before-cache
1328 ada-wisi-after-cache)
1329 'ada-wisi-post-parse-fail
1331 ada-grammar-wy--keyword-table
1332 ada-grammar-wy--token-table
1333 ada-grammar-wy--parse-table)
1334 (setq wisi-string-quote-escape-doubled t)
1336 (set (make-local-variable 'comment-indent-function) 'wisi-comment-indent)
1338 (add-hook 'hack-local-variables-hook 'ada-wisi-post-local-vars nil t)
1341 (defun ada-wisi-post-local-vars ()
1342 ;; run after file local variables are read because font-lock-add-keywords
1343 ;; evaluates font-lock-defaults, which depends on ada-language-version.
1344 (font-lock-add-keywords 'ada-mode
1345 ;; use keyword cache to distinguish between 'function ... return <type>;' and 'return ...;'
1350 "return[ \t]+access[ \t]+constant\\|"
1351 "return[ \t]+access\\|"
1354 ada-name-regexp "?")
1355 '(1 font-lock-keyword-face)
1356 '(2 (if (eq (when (not (ada-in-string-or-comment-p))
1357 (wisi-validate-cache (match-end 2))
1358 (and (wisi-get-cache (match-beginning 2))
1359 (wisi-cache-class (wisi-get-cache (match-beginning 2)))))
1366 (when global-font-lock-mode
1367 ;; ensure the modified keywords are applied
1368 (font-lock-refresh-defaults))
1371 (add-hook 'ada-mode-hook 'ada-wisi-setup)
1373 (setq ada-fix-context-clause 'ada-wisi-context-clause)
1374 (setq ada-goto-declaration-start 'ada-wisi-goto-declaration-start)
1375 (setq ada-goto-declarative-region-start 'ada-wisi-goto-declarative-region-start)
1376 (setq ada-goto-end 'wisi-goto-end)
1377 (setq ada-in-paramlist-p 'ada-wisi-in-paramlist-p)
1378 (setq ada-indent-statement 'wisi-indent-statement)
1379 (setq ada-make-subprogram-body 'ada-wisi-make-subprogram-body)
1380 (setq ada-next-statement-keyword 'wisi-forward-statement-keyword)
1381 (setq ada-prev-statement-keyword 'wisi-backward-statement-keyword)
1382 (setq ada-reset-parser 'wisi-invalidate-cache)
1383 (setq ada-scan-paramlist 'ada-wisi-scan-paramlist)
1384 (setq ada-show-parse-error 'wisi-show-parse-error)
1385 (setq ada-which-function 'ada-wisi-which-function)
1388 (provide 'ada-indent-engine)