X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/2d44e7fef7e7388759518cba1a424495119679d1..23a624ca1d40fa9cefd7229ac6152b79278a6517:/packages/ada-mode/ada-wisi.el?ds=sidebyside diff --git a/packages/ada-mode/ada-wisi.el b/packages/ada-mode/ada-wisi.el old mode 100755 new mode 100644 index c5ce9c212..e939ce785 --- a/packages/ada-mode/ada-wisi.el +++ b/packages/ada-mode/ada-wisi.el @@ -49,24 +49,27 @@ statement-end statement-other statement-start - type )) ;;;; indentation (defun ada-wisi-current-indentation () - "Return indentation of current line, incremented by 1 if starts with open-paren." + "Return indentation appropriate for point on current line: +if not in paren, beginning of line +if in paren, pos following paren." (if (not (ada-in-paren-p)) (current-indentation) - (save-excursion - (back-to-indentation) - (let ((cache (wisi-get-cache (point)))) - (if (and cache - (eq 'open-paren (wisi-cache-class cache))) - (1+ (current-column)) - (current-column)) - )))) + (or + (save-excursion + (let ((line (line-number-at-pos))) + (ada-goto-open-paren 1) + (when (= line (line-number-at-pos)) + (current-column)))) + (save-excursion + (back-to-indentation) + (current-column))) + )) (defun ada-wisi-indent-cache (offset cache) "Return indentation of OFFSET plus indentation of line containing point. Point must be at CACHE." @@ -182,7 +185,7 @@ point must be on CACHE. PREV-TOKEN is the token before the one being indented." (containing (wisi-goto-containing cache))) (cl-ecase (wisi-cache-token containing) (LEFT_PAREN - (if (equal break-point (cl-caddr prev-token)) + (if (equal break-point (cadr prev-token)) ;; we are indenting the first token after the list-break; not hanging. ;; ;; test/parent.adb @@ -259,7 +262,7 @@ point must be on CACHE. PREV-TOKEN is the token before the one being indented." ;; ;; type Limited_Derived_Type_1d is ;; abstract limited new Private_Type_1 with - ;; record + ;; record ;; indenting 'record' ;; ;; for Record_Type_1 use @@ -295,40 +298,57 @@ point must be on CACHE. PREV-TOKEN is the token before the one being indented." (close-paren (wisi-indent-paren 0)) + (keyword + ;; defer to after-cache) + nil) + (name - (cl-case (wisi-cache-nonterm cache) - ((function_specification procedure_specification) - ;; test/ada_mode-nominal.ads - ;; not - ;; overriding - ;; procedure - ;; Procedure_1c (Item : in out Parent_Type_1); - ;; indenting 'Procedure_1c' - ;; - ;; not overriding function - ;; Function_2e (Param : in Parent_Type_1) return Float; - ;; indenting 'Function_2e' - (ada-wisi-indent-containing ada-indent-broken cache t)) + (cond + ((let ((temp (save-excursion (wisi-goto-containing cache)))) + (and temp + (memq (wisi-cache-nonterm temp) '(subprogram_body subprogram_declaration)))) + ;; test/ada_mode-nominal.ads + ;; not + ;; overriding + ;; procedure + ;; Procedure_1c (Item : in out Parent_Type_1); + ;; indenting 'Procedure_1c' + ;; + ;; not overriding function + ;; Function_2e (Param : in Parent_Type_1) return Float; + ;; indenting 'Function_2e' + (ada-wisi-indent-containing ada-indent-broken cache t)) - (t - ;; defer to ada-wisi-after-cache, for consistency - nil) - )) + (t + ;; defer to ada-wisi-after-cache, for consistency + nil) + )) (name-paren ;; defer to ada-wisi-after-cache, for consistency nil) (open-paren - (let ((containing (wisi-goto-containing cache))) + (let* ((containing (wisi-goto-containing cache)) + (containing-pos (point))) (cl-case (wisi-cache-token containing) (COMMA ;; test/ada_mode-parens.adb ;; A : Matrix_Type := ;; ((1, 2, 3), ;; (4, 5, 6), - ;; indenting (4 - (ada-wisi-indent-containing 0 containing)) + ;; indenting (4; containing is '),' ; 0 + ;; + ;; test/ada_mode-parens.adb + ;; Local_14 : Local_14_Type := + ;; ("123", + ;; "456" & + ;; ("789")); + ;; indenting ("4"; contaning is '3",' ; ada-indent-broken + + (ada-wisi-indent-containing + (if (= (nth 1 prev-token) containing-pos) 0 ada-indent-broken) + containing)) (EQUAL_GREATER (setq containing (wisi-goto-containing containing)) @@ -353,6 +373,12 @@ point must be on CACHE. PREV-TOKEN is the token before the one being indented." ;; (if J > 42 ;; indenting '(if'; containing is '=>' (+ (current-column) -1 ada-indent)) + (WITH + ;; test/aspects.ads + ;; function Wuff return Boolean with Pre => + ;; (for all x in U => + ;; indenting '(for'; containing is '=>', 'with', 'function' + (ada-wisi-indent-cache (1- ada-indent) containing)) )) ((FUNCTION PROCEDURE) @@ -388,7 +414,7 @@ point must be on CACHE. PREV-TOKEN is the token before the one being indented." ;; (Local_2 = 1) (+ (ada-wisi-current-indentation) ada-indent-broken)) - (name + ((IDENTIFIER selected_component name) ;; test/indent.ads ;; CSCL_Type' ;; ( @@ -408,6 +434,12 @@ point must be on CACHE. PREV-TOKEN is the token before the one being indented." ;; (1.0), ;; B => Integer ;; (2.0)); + ;; + ;; test/ada_mode-parens.adb + ;; Local_12 : Local_11_Type + ;; := Local_11_Type'(A => Integer + ;; (1.0), + ;; indenting (1.0) (+ (ada-wisi-current-indentation) ada-indent-broken)) (t @@ -451,207 +483,241 @@ point must be on CACHE. PREV-TOKEN is the token before the one being indented." (ada-wisi-indent-containing ada-indent-broken cache t)) (statement-other - (let ((containing (wisi-goto-containing cache nil))) - (cl-case (wisi-cache-token cache) - (EQUAL_GREATER - (+ (current-column) ada-indent-broken)) - - (ELSIF - ;; test/g-comlin.adb - ;; elsif Current_Argument < CL.Argument_Count then - (ada-wisi-indent-cache 0 containing)) - - (RENAMES - (cl-ecase (wisi-cache-nonterm containing) - ((generic_renaming_declaration subprogram_renaming_declaration) - (wisi-forward-find-token '(FUNCTION PROCEDURE) pos-0) - (let ((pos-subprogram (point)) - (has-params - ;; this is wrong for one return access - ;; function case: overriding function Foo - ;; return access Bar (...) renames ...; - (wisi-forward-find-token 'LEFT_PAREN pos-0 t))) - (if has-params - (if (<= ada-indent-renames 0) - ;; indent relative to paren - (+ (current-column) (- ada-indent-renames)) - ;; else relative to line containing keyword + (save-excursion + (let ((containing (wisi-goto-containing cache nil))) + (while (not (wisi-cache-nonterm containing)) + (setq containing (wisi-goto-containing containing))) + + (cond + ;; cases to defer to after-cache + ((and + (eq (wisi-cache-nonterm cache) 'qualified_expression) + ;; test/ada_mode-parens.adb Local_13 Integer' + (not (eq (wisi-cache-token containing) 'COLON_EQUAL))) + ;; _not_ test/indent.ads CSCL_Type' + nil) + + ;; handled here + (t + (cl-case (wisi-cache-token cache) + (EQUAL_GREATER + (+ (current-column) ada-indent-broken)) + + (ELSIF + ;; test/g-comlin.adb + ;; elsif Current_Argument < CL.Argument_Count then + (ada-wisi-indent-cache 0 containing)) + + (RENAMES + (cl-ecase (wisi-cache-nonterm containing) + ((generic_renaming_declaration subprogram_renaming_declaration) + (wisi-forward-find-token '(FUNCTION PROCEDURE) pos-0) + (let ((pos-subprogram (point)) + (has-params + ;; this is wrong for one return access + ;; function case: overriding function Foo + ;; return access Bar (...) renames ...; + (wisi-forward-find-token 'LEFT_PAREN pos-0 t))) + (if has-params + (if (<= ada-indent-renames 0) + ;; indent relative to paren + (+ (current-column) (- ada-indent-renames)) + ;; else relative to line containing keyword + (goto-char pos-subprogram) + (+ (current-indentation) ada-indent-renames)) + + ;; no params (goto-char pos-subprogram) - (+ (current-indentation) ada-indent-renames)) + (+ (current-indentation) ada-indent-broken)) + )) - ;; no params - (goto-char pos-subprogram) + (object_renaming_declaration (+ (current-indentation) ada-indent-broken)) - )) - - (object_renaming_declaration - (+ (current-indentation) ada-indent-broken)) - )) - - (t - (while (not (wisi-cache-nonterm containing)) - (setq containing (wisi-goto-containing containing))) - - (cl-ecase (wisi-cache-nonterm containing) - (aggregate - ;; indenting 'with' - (+ (current-column) 1)) - - (association_opt - ;; test/indent.ads - ;; 1 => -- Used to be aligned on "CSCL_Type'" - ;; -- aligned with previous comment. - ;; IO_CPU_Control_State_S_Pkg.CPU2_Fault_Status_Type' - (ada-wisi-indent-cache ada-indent-broken containing)) - - (asynchronous_select - ;; indenting 'abort' - (+ (current-column) ada-indent-broken)) - - (component_declaration - ;; test/ada_mode-nominal.ads record_type_3 - (+ (current-column) ada-indent-broken)) - - (entry_body - ;; indenting 'when' - (+ (current-column) ada-indent-broken)) - - (formal_package_declaration - ;; test/ada_mode-generic_package.ads - ;; with package A_Package_7 is - ;; new Ada.Text_IO.Integer_IO (Num => Formal_Signed_Integer_Type); - ;; indenting 'new' - (+ (current-column) ada-indent-broken)) - - (full_type_declaration - ;; test/ada_mode-nominal.ads - ;; type Unconstrained_Array_Type_3 is array (Integer range <>, Standard.Character range <>) - ;; of Object_Access_Type_1; - ;; indenting 'of' - ;; - ;; type Object_Access_Type_7 - ;; is access all Integer; - ;; indenting 'is' - ;; - ;; type Limited_Derived_Type_1 is abstract limited new Private_Type_1 with - ;; record - ;; indenting 'record' - ;; - ;; type Limited_Derived_Type_3 is abstract limited new Private_Type_1 - ;; with null record; - ;; indenting 'with' - ;; - ;; type Limited_Derived_Type_2a is abstract limited new Private_Type_1 - ;; with record - ;; indenting 'with record' - (while (not (eq 'TYPE (wisi-cache-token containing))) - (setq containing (wisi-goto-containing containing))) - - (cond - ((eq (wisi-cache-token cache) 'RECORD) - (+ (current-column) ada-indent-record-rel-type)) - - ((eq (wisi-cache-token cache) 'WITH) - (let ((type-col (current-column))) - (wisi-goto-end-1 cache) - (if (eq 'WITH (wisi-cache-token (wisi-backward-cache))) - ;; 'with null record;' or 'with private;' - (+ type-col ada-indent-broken) - (+ type-col ada-indent-record-rel-type)))) - - (t - (+ (current-column) ada-indent-broken)) - )) - - (generic_instantiation - ;; test/ada_mode-generic_instantiation.ads - ;; procedure Procedure_7 is - ;; new Instance.Generic_Procedure (Integer, Function_1); - ;; indenting 'new' - (+ (current-column) ada-indent-broken)) - - (generic_renaming_declaration - ;; indenting keyword following 'generic' - (current-column)) - - (object_declaration - (cl-ecase (wisi-cache-token containing) - (COLON - ;; test/ada_mode-nominal.ads - ;; Anon_Array_3 : array (1 .. 10) - ;; of Integer; - ;; indenting 'of' - (+ (current-indentation) ada-indent-broken)) - - (COLON_EQUAL - ;; test/indent.ads - ;; C_S_Controls : constant - ;; CSCL_Type := - ;; CSCL_Type' - ;; indenting 'CSCL_Type' - (+ (current-indentation) ada-indent-broken)) - - (identifier_list - ;; test/ada_mode-nominal.adb - ;; Local_2 : constant Float - ;; := Local_1; - (+ (current-indentation) ada-indent-broken)) - )) - - (private_type_declaration - ;; test/aspects.ads - ;; type Vector is tagged private - ;; with - ;; indenting 'with' - (current-indentation)) - - (qualified_expression - ;; test/ada_mode-nominal-child.ads - ;; Child_Obj_5 : constant Child_Type_1 := - ;; (Parent_Type_1' - ;; (Parent_Element_1 => 1, - (ada-wisi-indent-cache ada-indent-broken containing)) - - (statement - (cl-case (wisi-cache-token containing) - (label_opt - (- (current-column) ada-indent-label)) - - (t - ;; test/ada_mode-nominal.adb - ;; select - ;; delay 1.0; - ;; then - ;; -- ... - ;; abort - (ada-wisi-indent-cache ada-indent-broken cache)) - )) - - ((subprogram_body subprogram_declaration subprogram_specification null_procedure_declaration) - (cl-ecase (wisi-cache-token cache) - (OVERRIDING - ;; indenting 'overriding' following 'not' - (current-column)) - - ((PROCEDURE FUNCTION) - ;; indenting 'procedure' or 'function following 'overriding' - (current-column)) - - (WITH - ;; indenting aspect specification on subprogram declaration - ;; test/aspects.ads - ;; procedure Foo (X : Integer; - ;; Y : out Integer) - ;; with Pre => X > 10 and - ;; indenting 'with' - (current-column)) - )) + )) - (subtype_declaration - ;; test/adacore_9717_001.ads A_Long_Name - (+ (current-column) ada-indent-broken)) + (t + (cl-ecase (wisi-cache-nonterm containing) + (aggregate + ;; test/ada_mode-nominal-child.adb + ;; return (Parent_Type_1 + ;; with 1, 0.0, False); + ;; indenting 'with'; containing is '(' + (+ (current-column) 1)) + + (component_declaration + ;; test/ada_mode-nominal.ads Record_Type_3 ':' + (+ (current-column) ada-indent-broken)) + + (entry_body + ;; test/ada_mode-nominal.adb + ;; entry E2 + ;; (X : Integer) + ;; when Local_1 = 0 and not + ;; indenting 'when'; containing is 'entry' + (+ (current-column) ada-indent-broken)) + + (formal_package_declaration + ;; test/ada_mode-generic_package.ads + ;; with package A_Package_7 is + ;; new Ada.Text_IO.Integer_IO (Num => Formal_Signed_Integer_Type); + ;; indenting 'new'; containing is 'with' + (+ (current-column) ada-indent-broken)) + + ((full_type_declaration subtype_declaration) + (while (not (memq (wisi-cache-token containing) '(TYPE SUBTYPE))) + (setq containing (wisi-goto-containing containing))) + + (cond + ((eq (wisi-cache-token cache) 'WITH) + (let ((type-col (current-column)) + (null_private (save-excursion (wisi-goto-end-1 cache) + (eq 'WITH (wisi-cache-token (wisi-backward-cache)))))) + (cond + ((eq 'aspect_specification_opt (wisi-cache-nonterm cache)) + ;; test/aspects.ads + ;; subtype Integer_String is String + ;; with Dynamic_Predicate => Integer'Value (Integer_String) in Integer + ;; indenting 'with' + type-col) + + (null_private + ;; 'with null record;' or 'with private;' + ;; test/ada_mode-nominal.ads + ;; type Limited_Derived_Type_3 is abstract limited new Private_Type_1 + ;; with null record; + ;; indenting 'with'; containing is 'is' + (+ type-col ada-indent-broken)) + + (t + ;; test/ada_mode-nominal.ads + ;; type Unconstrained_Array_Type_3 is array (Integer range <>, Standard.Character range <>) + ;; of Object_Access_Type_1; + ;; indenting 'of'; containing is 'is' + ;; + ;; type Object_Access_Type_7 + ;; is access all Integer; + ;; indenting 'is'; containing is 'type' + (+ type-col ada-indent-record-rel-type))))) + + (t + ;; test/ada_mode-nominal.ads + ;; type Limited_Derived_Type_2a is abstract limited new Private_Type_1 + ;; with record + ;; indenting 'with record' + ;; + ;; test/access_in_record.ads + ;; type A + ;; is new Ada.Streams.Root_Stream_Type with record + ;; + ;; test/adacore_9717_001.ads A_Long_Name + ;; subtype A_Long_Name + ;; is Ada.Text_Io.Count; + ;; indenting 'is' + (+ (current-column) ada-indent-broken)) + )) + + (generic_instantiation + ;; test/ada_mode-generic_instantiation.ads + ;; procedure Procedure_7 is + ;; new Instance.Generic_Procedure (Integer, Function_1); + ;; indenting 'new' + (+ (current-column) ada-indent-broken)) + + (generic_renaming_declaration + ;; indenting keyword following 'generic' + (current-column)) + + (object_declaration + (cl-ecase (wisi-cache-token containing) + (COLON + ;; test/ada_mode-nominal.ads + ;; Anon_Array_3 : array (1 .. 10) + ;; of Integer; + ;; indenting 'of' + (+ (current-indentation) ada-indent-broken)) + + (COLON_EQUAL + ;; test/indent.ads + ;; C_S_Controls : constant + ;; CSCL_Type := + ;; CSCL_Type' + ;; indenting 'CSCL_Type' + (+ (current-indentation) ada-indent-broken)) + + (identifier_list + ;; test/ada_mode-nominal.adb + ;; Local_2 : constant Float + ;; := Local_1; + (+ (current-indentation) ada-indent-broken)) + )) + + (private_extension_declaration + ;; test/ada_mode-nominal.ads + ;; type Limited_Derived_Type_3 is abstract limited + ;; new Private_Type_1 with private; + (+ (current-indentation) ada-indent-broken)) - ))))) ;; end statement-other + (private_type_declaration + ;; test/aspects.ads + ;; type Vector is tagged private + ;; with + ;; indenting 'with' + (current-indentation)) + + (qualified_expression + ;; test/ada_mode-nominal-child.ads + ;; Child_Obj_5 : constant Child_Type_1 := + ;; (Parent_Type_1' + ;; (Parent_Element_1 => 1, + (ada-wisi-indent-cache ada-indent-broken containing)) + + (statement + (cl-case (wisi-cache-token containing) + (label_opt + (- (current-column) ada-indent-label)) + + (t + ;; test/ada_mode-nominal.adb + ;; select + ;; delay 1.0; + ;; then + ;; -- ... + ;; abort + (ada-wisi-indent-cache ada-indent-broken cache)) + )) + + ((subprogram_body subprogram_declaration subprogram_specification null_procedure_declaration) + (cl-ecase (wisi-cache-token cache) + (IS + ;; test/ada_mode-nominal.ads + ;; procedure Procedure_1d + ;; (Item : in out Parent_Type_1; + ;; Item_1 : in Character; + ;; Item_2 : out Character) + ;; is null; + ;; indenting 'is' + (+ (current-column) ada-indent-broken)) + + (OVERRIDING + ;; indenting 'overriding' following 'not' + (current-column)) + + ((PROCEDURE FUNCTION) + ;; indenting 'procedure' or 'function following 'overriding' + (current-column)) + + (WITH + ;; indenting aspect specification on subprogram declaration + ;; test/aspects.ads + ;; procedure Foo (X : Integer; + ;; Y : out Integer) + ;; with Pre => X > 10 and + ;; indenting 'with' + (current-column)) + )) + + )))) + )))) ;; end statement-other (statement-start (cond @@ -683,397 +749,443 @@ point must be on CACHE. PREV-TOKEN is the token before the one being indented." nil) )))) )) - - (type - (ada-wisi-indent-containing ada-indent-broken cache t)) )) )) (defun ada-wisi-after-cache () "Point is at indentation, not before a cached token. Find previous cached token, return new indentation for point." - (let ((start (point)) - (prev-token (save-excursion (wisi-backward-token))) - (cache (wisi-backward-cache))) + (save-excursion + (let ((start (point)) + (prev-token (save-excursion (wisi-backward-token))) + (cache (wisi-backward-cache))) - (cond - ((not cache) ;; bob + (cond + ((not cache) ;; bob 0) - (t - (while (memq (wisi-cache-class cache) '(name name-paren type)) - ;; not useful for indenting - (setq cache (wisi-backward-cache))) - - (cl-ecase (wisi-cache-class cache) - (block-end - ;; indenting block/subprogram name after 'end' - (wisi-indent-current ada-indent-broken)) + (t + (while (memq (wisi-cache-class cache) '(keyword name name-paren type)) + ;; not useful for indenting + (setq cache (wisi-backward-cache))) - (block-middle - (cl-case (wisi-cache-token cache) - (IS - (cl-case (wisi-cache-nonterm cache) - (case_statement - ;; between 'case .. is' and first 'when'; most likely a comment - (ada-wisi-indent-containing 0 cache t)) + (cl-ecase (wisi-cache-class cache) + (block-end + ;; indenting block/subprogram name after 'end' + (wisi-indent-current ada-indent-broken)) - (t - (+ (ada-wisi-indent-containing ada-indent cache t))) - )) + (block-middle + (cl-case (wisi-cache-token cache) + (IS + (cl-case (wisi-cache-nonterm cache) + (case_statement + ;; between 'case .. is' and first 'when'; most likely a comment + (ada-wisi-indent-containing 0 cache t)) - ((THEN ELSE) - (let ((indent - (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache)) - ((statement if_statement elsif_statement_item) ada-indent) - ((if_expression elsif_expression_item) ada-indent-broken)))) - (ada-wisi-indent-containing indent cache t))) + (t + (+ (ada-wisi-indent-containing ada-indent cache t))) + )) - (WHEN - ;; between 'when' and '=>' - (+ (current-column) ada-indent-broken)) + ((THEN ELSE) + ;; + ;; test/ada_mode-conditional_expressions.adb + ;; K3 : Integer := (if + ;; J > 42 + ;; then + ;; -1 + ;; else + ;; +1); + ;; indenting -1, +1 + (let ((indent + (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache)) + ((statement if_statement elsif_statement_item) ada-indent) + ((if_expression elsif_expression_item) ada-indent-broken)))) + (ada-wisi-indent-containing indent cache t))) - (t - ;; block-middle keyword may not be on separate line: - ;; function Create (Model : in Integer; - ;; Context : in String) return String is - (ada-wisi-indent-containing ada-indent cache nil)) - )) + (WHEN + ;; between 'when' and '=>' + (+ (current-column) ada-indent-broken)) - (block-start - (cl-case (wisi-cache-nonterm cache) - (exception_handler - ;; between 'when' and '=>' - (+ (current-column) ada-indent-broken)) + (t + ;; block-middle keyword may not be on separate line: + ;; function Create (Model : in Integer; + ;; Context : in String) return String is + (ada-wisi-indent-containing ada-indent cache nil)) + )) - (if_expression - (ada-wisi-indent-containing ada-indent-broken cache nil)) + (block-start + (cl-case (wisi-cache-nonterm cache) + (exception_handler + ;; between 'when' and '=>' + (+ (current-column) ada-indent-broken)) - (select_alternative - (ada-wisi-indent-containing (+ ada-indent-when ada-indent-broken) cache nil)) + (if_expression + (ada-wisi-indent-containing ada-indent-broken cache nil)) - (t ;; other; normal block statement - (ada-wisi-indent-cache ada-indent cache)) - )) + (select_alternative + (ada-wisi-indent-containing (+ ada-indent-when ada-indent-broken) cache nil)) - (close-paren - ;; actual_parameter_part: test/ada_mode-nominal.adb - ;; return 1.0 + - ;; Foo (Bar) + -- multi-line expression that happens to have a cache at a line start - ;; 12; - ;; indenting '12'; don't indent relative to containing function name - ;; - ;; attribute_designator: test/ada_mode-nominal.adb - ;; raise Constraint_Error with Count'Image (Line (File)) & - ;; "foo"; - ;; indenting '"foo"'; relative to raise - ;; - ;; test/ada_mode-slices.adb - ;; Put_Line(Day'Image(D1) & " - " & Day'Image(D2) & " = " & - ;; Integer'Image(N)); - ;; indenting 'Integer' - (when (memq (wisi-cache-nonterm cache) - '(actual_parameter_part attribute_designator)) - (setq cache (wisi-goto-containing cache))) - (ada-wisi-indent-containing ada-indent-broken cache nil)) - - (list-break - (ada-wisi-indent-list-break cache prev-token)) + (t ;; other; normal block statement + (ada-wisi-indent-cache ada-indent cache)) + )) - (open-paren - ;; 1) A parenthesized expression, or the first item in an aggregate: - ;; - ;; (foo + - ;; bar) - ;; (foo => - ;; bar) - ;; - ;; we are indenting 'bar' - ;; - ;; 2) A parenthesized expression, or the first item in an - ;; aggregate, and there is whitespace between - ;; ( and the first token: - ;; - ;; test/ada_mode-parens.adb - ;; Local_9 : String := ( - ;; "123" - ;; - ;; 3) A parenthesized expression, or the first item in an - ;; aggregate, and there is a comment between - ;; ( and the first token: - ;; - ;; test/ada_mode-nominal.adb - ;; A := - ;; ( - ;; -- a comment between paren and first association - ;; 1 => - ;; - ;; test/ada_mode-parens.adb - ;; return Float ( - ;; Integer'Value - ;; indenting 'Integer' - (let ((paren-column (current-column)) - (start-is-comment (save-excursion (goto-char start) (looking-at comment-start-skip)))) - (wisi-forward-token t); point is now after paren - (if start-is-comment - (skip-syntax-forward " >"); point is now on comment - (forward-comment (point-max)); point is now on first token - ) - (if (= (point) start) - ;; case 2) or 3) - (1+ paren-column) - ;; 1) - (+ paren-column 1 ada-indent-broken)))) - - ((return-1 return-2) - ;; hanging. Intent relative to line containing matching 'function' - (ada-prev-statement-keyword) - (back-to-indentation) - (+ (current-column) ada-indent-broken)) + (close-paren + ;; actual_parameter_part: test/ada_mode-nominal.adb + ;; return 1.0 + + ;; Foo (Bar) + -- multi-line expression that happens to have a cache at a line start + ;; 12; + ;; indenting '12'; don't indent relative to containing function name + ;; + ;; attribute_designator: test/ada_mode-nominal.adb + ;; raise Constraint_Error with Count'Image (Line (File)) & + ;; "foo"; + ;; indenting '"foo"'; relative to raise + ;; + ;; test/ada_mode-slices.adb + ;; Put_Line(Day'Image(D1) & " - " & Day'Image(D2) & " = " & + ;; Integer'Image(N)); + ;; indenting 'Integer' + (when (memq (wisi-cache-nonterm cache) + '(actual_parameter_part attribute_designator)) + (setq cache (wisi-goto-containing cache))) + (ada-wisi-indent-containing ada-indent-broken cache nil)) + + (list-break + (ada-wisi-indent-list-break cache prev-token)) + + (open-paren + ;; 1) A parenthesized expression, or the first item in an aggregate: + ;; + ;; (foo + + ;; bar) + ;; (foo => + ;; bar) + ;; + ;; we are indenting 'bar' + ;; + ;; 2) A parenthesized expression, or the first item in an + ;; aggregate, and there is whitespace between + ;; ( and the first token: + ;; + ;; test/ada_mode-parens.adb + ;; Local_9 : String := ( + ;; "123" + ;; + ;; 3) A parenthesized expression, or the first item in an + ;; aggregate, and there is a comment between + ;; ( and the first token: + ;; + ;; test/ada_mode-nominal.adb + ;; A := + ;; ( + ;; -- a comment between paren and first association + ;; 1 => + ;; + ;; test/ada_mode-parens.adb + ;; return Float ( + ;; Integer'Value + ;; indenting 'Integer' + (let ((paren-column (current-column)) + (start-is-comment (save-excursion (goto-char start) (looking-at comment-start-skip)))) + (wisi-forward-token); point is now after paren + (if start-is-comment + (skip-syntax-forward " >"); point is now on comment + (forward-comment (point-max)); point is now on first token + ) + (if (= (point) start) + ;; case 2) or 3) + (1+ paren-column) + ;; 1) + (+ paren-column 1 ada-indent-broken)))) + + ((return-1 return-2) + ;; test/ada_mode-nominal.adb + ;; function Function_Access_1 + ;; (A_Param : in Float) + ;; return + ;; Standard.Float + ;; indenting 'Standard.Float' + ;; + ;; test/ada_mode-expression_functions.ads + ;; function Square (A : in Float) return Float + ;; is (A * A); + ;; indenting 'is' + ;; + ;; test/ada_mode-nominal.ads + ;; function Function_2g + ;; (Param : in Private_Type_1) + ;; return Float + ;; is abstract; + ;; indenting 'is' + (back-to-indentation) + (+ (current-column) ada-indent-broken)) + + (statement-end + (ada-wisi-indent-containing 0 cache nil)) + + (statement-other + (cl-ecase (wisi-cache-token cache) + (ABORT + ;; select + ;; Please_Abort; + ;; then + ;; abort + ;; -- 'abort' indented with ada-indent-broken, since this is part + ;; Titi; + (ada-wisi-indent-containing ada-indent cache)) + + ;; test/subdir/ada_mode-separate_task_body.adb + ((COLON COLON_EQUAL) + ;; Local_3 : constant Float := + ;; Local_2; + ;; + ;; test/ada_mode-nominal.ads + ;; type Record_Type_3 (Discriminant_1 : access Integer) is tagged record + ;; Component_1 : Integer; -- end 2 + ;; Component_2 : + ;; Integer; + ;; indenting 'Integer'; containing is ';' + (ada-wisi-indent-cache ada-indent-broken cache)) - (statement-end - (ada-wisi-indent-containing 0 cache nil)) + (COMMA + (cl-ecase (wisi-cache-nonterm cache) + (name_list + (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache)) + (use_clause + ;; test/with_use1.adb + (ada-wisi-indent-containing ada-indent-use cache)) + + (with_clause + ;; test/ada_mode-nominal.ads + ;; limited private with Ada.Strings.Bounded, + ;; --EMACSCMD:(test-face "Ada.Containers" 'default) + ;; Ada.Containers; + ;; + ;; test/with_use1.adb + (ada-wisi-indent-containing ada-indent-with cache)) + )) + )) - (statement-other - (cl-ecase (wisi-cache-token cache) - (ABORT - ;; select - ;; Please_Abort; - ;; then - ;; abort - ;; -- 'abort' indented with ada-indent-broken, since this is part - ;; Titi; - (ada-wisi-indent-containing ada-indent cache)) - - ;; test/subdir/ada_mode-separate_task_body.adb - ((COLON COLON_EQUAL) - ;; Local_3 : constant Float := - ;; Local_2; - (ada-wisi-indent-cache ada-indent-broken cache)) - - (COMMA - (cl-ecase (wisi-cache-nonterm cache) - (name_list - (cl-ecase (wisi-cache-nonterm (wisi-get-containing-cache cache)) - (use_clause - ;; test/with_use1.adb - (ada-wisi-indent-containing ada-indent-use cache)) - - (with_clause - ;; test/ada_mode-nominal.ads - ;; limited private with Ada.Strings.Bounded, - ;; --EMACSCMD:(test-face "Ada.Containers" 'default) - ;; Ada.Containers; - ;; - ;; test/with_use1.adb - (ada-wisi-indent-containing ada-indent-with cache)) - )) - )) - - (ELSIF - ;; test/g-comlin.adb - ;; elsif Index_Switches + Max_Length <= Switches'Last - ;; and then Switches (Index_Switches + Max_Length) = '?' - (ada-wisi-indent-cache ada-indent-broken cache)) - - (EQUAL_GREATER - (let ((cache-col (current-column)) - (cache-pos (point)) - (line-end-pos (line-end-position)) - (containing (wisi-goto-containing cache nil))) - (while (eq (wisi-cache-nonterm containing) 'association_list) - (setq containing (wisi-goto-containing containing nil))) - - (cl-ecase (wisi-cache-nonterm containing) - ((actual_parameter_part aggregate) - ;; ada_mode-generic_package.ads - ;; with package A_Package_2 is new Ada.Text_IO.Integer_IO (Num => - ;; Formal_Signed_Integer_Type); - ;; indenting 'Formal_Signed_...', point on '(Num' - ;; - ;; test/ada_mode-parens.adb - ;; (1 => - ;; 1, - ;; 2 => - ;; 1 + 2 * 3, - ;; indenting '1,' or '1 +'; point on '(1' - (+ (current-column) 1 ada-indent-broken)) + (ELSIF + ;; test/g-comlin.adb + ;; elsif Index_Switches + Max_Length <= Switches'Last + ;; and then Switches (Index_Switches + Max_Length) = '?' + (ada-wisi-indent-cache ada-indent-broken cache)) - (aspect_specification_opt - ;; test/aspects.ads - ;; with Pre => X > 10 and - ;; X < 50 and - ;; F (X), - ;; Post => - ;; Y >= X and - ;; indenting 'X < 50' or 'Y >= X'; cache is '=>', point is on '=>' - ;; or indenting 'Post =>'; cache is ',', point is on 'with' - (cl-ecase (wisi-cache-token cache) - (COMMA - (+ (current-indentation) ada-indent-broken)) - - (EQUAL_GREATER - (if (= (+ 2 cache-pos) line-end-pos) - ;; Post => - ;; Y >= X and - (progn - (goto-char cache-pos) - (+ (current-indentation) ada-indent-broken)) - ;; with Pre => X > 10 and - ;; X < 50 and - (+ 3 cache-col))) - )) + (EQUAL_GREATER + (let ((cache-col (current-column)) + (cache-pos (point)) + (line-end-pos (line-end-position)) + (containing (wisi-goto-containing cache nil))) + (while (eq (wisi-cache-nonterm containing) 'association_list) + (setq containing (wisi-goto-containing containing nil))) + + (cl-ecase (wisi-cache-nonterm containing) + ((actual_parameter_part aggregate) + ;; ada_mode-generic_package.ads + ;; with package A_Package_2 is new Ada.Text_IO.Integer_IO (Num => + ;; Formal_Signed_Integer_Type); + ;; indenting 'Formal_Signed_...', point on '(Num' + ;; + ;; test/ada_mode-parens.adb + ;; (1 => + ;; 1, + ;; 2 => + ;; 1 + 2 * 3, + ;; indenting '1,' or '1 +'; point on '(1' + ;; + ;; test/ada_mode-parens.adb + ;; Local_13 : Local_11_Type + ;; := (Integer'(1), + ;; Integer'(2)); + ;; indenting 'Integer'; point on '(Integer' + (+ (current-column) 1 ada-indent-broken)) + + (aspect_specification_opt + ;; test/aspects.ads + ;; with Pre => X > 10 and + ;; X < 50 and + ;; F (X), + ;; Post => + ;; Y >= X and + ;; indenting 'X < 50' or 'Y >= X'; cache is '=>', point is on '=>' + ;; or indenting 'Post =>'; cache is ',', point is on 'with' + (cl-ecase (wisi-cache-token cache) + (COMMA + (+ (current-indentation) ada-indent-broken)) + + (EQUAL_GREATER + (if (= (+ 2 cache-pos) line-end-pos) + ;; Post => + ;; Y >= X and + (progn + (goto-char cache-pos) + (+ (current-indentation) ada-indent-broken)) + ;; with Pre => X > 10 and + ;; X < 50 and + (+ 3 cache-col))) + )) + + (association_list + (cl-ecase (save-excursion (wisi-cache-token (wisi-goto-containing cache nil))) + (COMMA + (ada-wisi-indent-containing (* 2 ada-indent-broken) cache)) + )) + + ((case_expression_alternative case_statement_alternative exception_handler) + ;; containing is 'when' + (+ (current-column) ada-indent)) + + (generic_renaming_declaration + ;; not indenting keyword following 'generic' + (+ (current-column) ada-indent-broken)) - (association_list - (cl-ecase (save-excursion (wisi-cache-token (wisi-goto-containing cache nil))) - (COMMA - (ada-wisi-indent-containing (* 2 ada-indent-broken) cache)) - )) + (primary + ;; test/ada_mode-quantified_expressions.adb + ;; if (for some J in 1 .. 10 => + ;; J/2 = 0) + (ada-wisi-indent-containing ada-indent-broken cache)) + + + (select_alternative + ;; test/ada_mode-nominal.adb + ;; or when Started + ;; => + ;; accept Finish; + ;; indenting 'accept'; point is on 'when' + (+ (current-column) ada-indent)) + + (variant + ;; test/generic_param.adb + ;; case Item_Type is + ;; when Fix | Airport => + ;; null; + ;; indenting 'null' + (+ (current-column) ada-indent)) + + ))) + + (IS + (setq cache (wisi-goto-containing cache)) + (cl-ecase (wisi-cache-nonterm cache) + (full_type_declaration + ;; ada_mode/nominal.ads + ;; type Limited_Derived_Type_1a is abstract limited new + ;; Private_Type_1 with record + ;; Component_1 : Integer; + ;; indenting 'Private_Type_1'; look for 'record' + (let ((type-column (current-column))) + (goto-char start) + (if (wisi-forward-find-token 'RECORD (line-end-position) t) + ;; 'record' on line being indented + (+ type-column ada-indent-record-rel-type) + ;; 'record' on later line + (+ type-column ada-indent-broken)))) + + ((formal_type_declaration + ;; test/ada_mode-generic_package.ads + ;; type Synchronized_Formal_Derived_Type is abstract synchronized new Formal_Private_Type and Interface_Type + ;; with private; + + subtype_declaration) + ;; test/ada_mode-nominal.ads + ;; subtype Subtype_2 is Signed_Integer_Type range 10 .. + ;; 20; - ((case_expression_alternative case_statement_alternative exception_handler) - ;; containing is 'when' - (+ (current-column) ada-indent)) + (+ (current-column) ada-indent-broken)) - (generic_renaming_declaration - ;; not indenting keyword following 'generic' + (null_procedure_declaration + ;; ada_mode-nominal.ads + ;; procedure Procedure_3b is + ;; null; + ;; indenting null (+ (current-column) ada-indent-broken)) - (primary - ;; test/ada_mode-quantified_expressions.adb - ;; if (for some J in 1 .. 10 => - ;; J/2 = 0) - (ada-wisi-indent-containing ada-indent-broken cache)) + )) + (LEFT_PAREN + ;; test/indent.ads + ;; C_S_Controls : constant + ;; CSCL_Type := + ;; CSCL_Type' + ;; ( + ;; 1 => + (+ (current-column) 1)) + + (NEW + ;; ada_mode-nominal.ads + ;; type Limited_Derived_Type_2 is abstract limited new Private_Type_1 with + ;; private; + ;; + ;; test/ada_mode-generic_instantiation.ads + ;; procedure Procedure_6 is new + ;; Instance.Generic_Procedure (Integer, Function_1); + ;; indenting 'Instance'; containing is 'new' + (ada-wisi-indent-containing ada-indent-broken cache)) + + (OF + ;; ada_mode-nominal.ads + ;; Anon_Array_2 : array (1 .. 10) of + ;; Integer; + (ada-wisi-indent-containing ada-indent-broken cache)) - (select_alternative - ;; test/ada_mode-nominal.adb - ;; or when Started - ;; => - ;; accept Finish; - ;; indenting 'accept'; point is on 'when' - (+ (current-column) ada-indent)) - - (variant - ;; test/generic_param.adb - ;; case Item_Type is - ;; when Fix | Airport => - ;; null; - ;; indenting 'null' - (+ (current-column) ada-indent)) - - ))) - - (IS - (setq cache (wisi-goto-containing cache)) - (cl-ecase (wisi-cache-nonterm cache) - (full_type_declaration - ;; ada_mode/nominal.ads - ;; type Limited_Derived_Type_1a is abstract limited new - ;; Private_Type_1 with record - ;; Component_1 : Integer; - ;; indenting 'Private_Type_1'; look for 'record' - (let ((type-column (current-column))) - (goto-char start) - (if (wisi-forward-find-token 'RECORD (line-end-position) t) - ;; 'record' on line being indented - (+ type-column ada-indent-record-rel-type) - ;; 'record' on later line - (+ type-column ada-indent-broken)))) - - ((formal_type_declaration - ;; test/ada_mode-generic_package.ads - ;; type Synchronized_Formal_Derived_Type is abstract synchronized new Formal_Private_Type and Interface_Type - ;; with private; - - subtype_declaration) - ;; test/ada_mode-nominal.ads - ;; subtype Subtype_2 is Signed_Integer_Type range 10 .. - ;; 20; - - (+ (current-column) ada-indent-broken)) - )) - - (LEFT_PAREN - ;; test/indent.ads - ;; C_S_Controls : constant - ;; CSCL_Type := - ;; CSCL_Type' - ;; ( - ;; 1 => - (+ (current-column) 1)) - - (OF - ;; ada_mode-nominal.ads - ;; Anon_Array_2 : array (1 .. 10) of - ;; Integer; - (ada-wisi-indent-containing ada-indent-broken cache)) - - (NEW - ;; ada_mode-nominal.ads - ;; type Limited_Derived_Type_2 is abstract limited new Private_Type_1 with - ;; private; - ;; - ;; test/ada_mode-generic_instantiation.ads - ;; procedure Procedure_6 is new - ;; Instance.Generic_Procedure (Integer, Function_1); - ;; indenting 'Instance'; containing is 'new' - (ada-wisi-indent-containing ada-indent-broken cache)) + (WHEN + ;; test/ada_mode-parens.adb + ;; exit when A.all + ;; or else B.all + (ada-wisi-indent-containing ada-indent-broken cache)) - (WHEN - ;; test/ada_mode-parens.adb - ;; exit when A.all - ;; or else B.all - (ada-wisi-indent-containing ada-indent-broken cache)) - - (WITH - (cl-case (wisi-cache-nonterm cache) - (aggregate - ;; test/ada_mode-nominal-child.ads - ;; (Default_Parent with - ;; 10, 12.0, True); - ;; indenting '10'; containing is '(' - (ada-wisi-indent-containing 0 cache nil)) - - (aspect_specification_opt - ;; test/aspects.ads - ;; type Vector is tagged private - ;; with - ;; Constant_Indexing => Constant_Reference, - ;; indenting 'Constant_Indexing'; point is on 'with' - (+ (current-indentation) ada-indent-broken)) - - (raise_statement - ;; raise_statement: test/ada_mode-nominal.adb - ;; raise Constraint_Error with - ;; "help!"; - (ada-wisi-indent-containing ada-indent-broken cache nil)) - )) - - ;; otherwise just hanging - ((ACCEPT FUNCTION PROCEDURE RENAMES) - (back-to-indentation) - (+ (current-column) ada-indent-broken)) + (WITH + (cl-case (wisi-cache-nonterm cache) + (aggregate + ;; test/ada_mode-nominal-child.ads + ;; (Default_Parent with + ;; 10, 12.0, True); + ;; indenting '10'; containing is '(' + (ada-wisi-indent-containing 0 cache nil)) - )) + (aspect_specification_opt + ;; test/aspects.ads + ;; type Vector is tagged private + ;; with + ;; Constant_Indexing => Constant_Reference, + ;; indenting 'Constant_Indexing'; point is on 'with' + (+ (current-indentation) ada-indent-broken)) + )) - (statement-start - (cl-case (wisi-cache-token cache) - (WITH ;; with_clause - (+ (current-column) ada-indent-with)) + ;; otherwise just hanging + ((ACCEPT FUNCTION PROCEDURE RENAMES) + (back-to-indentation) + (+ (current-column) ada-indent-broken)) - (label_opt - ;; comment after label - (+ (current-column) (- ada-indent-label))) + )) - (t - ;; procedure Procedure_8 - ;; is new Instance.Generic_Procedure (Integer, Function_1); - ;; indenting 'is'; hanging - ;; (+ (current-column) ada-indent-broken)) - (ada-wisi-indent-cache ada-indent-broken cache)) - )) - ))) - )) + (statement-start + (cl-case (wisi-cache-token cache) + (WITH ;; with_clause + (+ (current-column) ada-indent-with)) + + (label_opt + ;; comment after label + (+ (current-column) (- ada-indent-label))) + + (t + ;; procedure Procedure_8 + ;; is new Instance.Generic_Procedure (Integer, Function_1); + ;; indenting 'is'; hanging + ;; + ;; test/ada_mode-conditional_expressions.adb + ;; K3 : Integer := (if + ;; J > 42 + ;; then + ;; -1 + ;; else + ;; +1); + ;; indenting J + (ada-wisi-indent-cache ada-indent-broken cache)) + )) + ))) + ))) (defun ada-wisi-comment () "Compute indentation of a comment. For `wisi-indent-calculate-functions'." @@ -1141,11 +1253,12 @@ cached token, return new indentation for point." (while (not end) (setq cache (wisi-forward-cache)) (cl-case (wisi-cache-nonterm cache) - (pragma nil) - (use_clause nil) + (pragma (wisi-goto-end-1 cache)) + (use_clause (wisi-goto-end-1 cache)) (with_clause (when (not begin) - (setq begin (point-at-bol)))) + (setq begin (point-at-bol))) + (wisi-goto-end-1 cache)) (t ;; start of compilation unit (setq end (point-at-bol)) @@ -1155,10 +1268,55 @@ cached token, return new indentation for point." (cons begin end) ))) +(defun ada-wisi-on-context-clause () + "For `ada-on-context-clause'." + + (save-excursion + (and (wisi-goto-statement-start) + (memq (wisi-cache-nonterm (wisi-goto-statement-start)) '(use_clause with_clause))))) + +(defun ada-wisi-goto-subunit-name () + "For `ada-goto-subunit-name'." + (wisi-validate-cache (point-max)) + (if (not (> wisi-cache-max (point))) + (progn + (message "parse failed; can't goto subunit name") + nil) + + (let ((end nil) + cache + (name-pos nil)) + (save-excursion + ;; move to top declaration + (goto-char (point-min)) + (setq cache (or (wisi-get-cache (point)) + (wisi-forward-cache))) + (while (not end) + (cl-case (wisi-cache-nonterm cache) + ((pragma use_clause with_clause) + (wisi-goto-end-1 cache) + (setq cache (wisi-forward-cache))) + (t + ;; start of compilation unit + (setq end t)) + )) + (when (eq (wisi-cache-nonterm cache) 'subunit) + (wisi-forward-find-class 'name (point-max)) ;; parent name + (wisi-forward-token) + (wisi-forward-find-class 'name (point-max)) ;; subunit name + (setq name-pos (point))) + ) + (when name-pos + (goto-char name-pos)) + ))) + (defun ada-wisi-goto-declaration-start () "For `ada-goto-declaration-start', which see. Also return cache at start." (wisi-validate-cache (point)) + (unless (> wisi-cache-max (point)) + (error "parse failed; can't goto declarative-region-start")) + (let ((cache (wisi-get-cache (point))) (done nil)) (unless cache @@ -1193,11 +1351,16 @@ Also return cache at start." (defun ada-wisi-goto-declaration-end () "For `ada-goto-declaration-end', which see." + ;; first goto-declaration-start, so we get the right end, not just + ;; the current statement end. (wisi-goto-end-1 (ada-wisi-goto-declaration-start))) (defun ada-wisi-goto-declarative-region-start () "For `ada-goto-declarative-region-start', which see." (wisi-validate-cache (point)) + (unless (> wisi-cache-max (point)) + (error "parse failed; can't goto declarative-region-start")) + (let ((done nil) (first t) (cache @@ -1213,7 +1376,7 @@ Also return cache at start." (while (not done) (if (ada-wisi-declarative-region-start-p cache) (progn - (wisi-forward-token t) + (wisi-forward-token) (setq done t)) (cl-case (wisi-cache-class cache) ((block-middle block-end) @@ -1296,10 +1459,14 @@ Also return cache at start." (defun ada-wisi-scan-paramlist (begin end) "For `ada-scan-paramlist'." (wisi-validate-cache end) + (when (< wisi-cache-max end) + (error "parse failed; can't scan paramlist")) + (goto-char begin) (let (token text identifiers + (aliased-p nil) (in-p nil) (out-p nil) (not-null-p nil) @@ -1317,7 +1484,7 @@ Also return cache at start." (while (not done) (let ((token-text (wisi-forward-token))) (setq token (nth 0 token-text)) - (setq text (nth 1 token-text))) + (setq text (wisi-token-text token-text))) (cond ((equal token 'COMMA) nil);; multiple identifiers @@ -1326,10 +1493,11 @@ Also return cache at start." (skip-syntax-forward " ") (setq type-begin (point)) (save-excursion - (while (member (car (wisi-forward-token)) '(IN OUT NOT NULL ACCESS CONSTANT PROTECTED)) + (while (member (car (wisi-forward-token)) '(ALIASED IN OUT NOT NULL ACCESS CONSTANT PROTECTED)) (skip-syntax-forward " ") (setq type-begin (point))))) + ((equal token 'ALIASED) (setq aliased-p t)) ((equal token 'IN) (setq in-p t)) ((equal token 'OUT) (setq out-p t)) ((and (not type-end) @@ -1347,26 +1515,23 @@ Also return cache at start." (wisi-forward-find-token 'SEMICOLON end t)) ((member token '(SEMICOLON RIGHT_PAREN)) - (if (equal token 'RIGHT_PAREN) - ;; all done - (progn - (setq done t) - (when (not type-end) (setq type-end (1- (point)))) - (when default-begin (setq default (buffer-substring-no-properties default-begin (1- (point))))) - ) - ;; else semicolon - one param done - (when (not type-end) (setq type-end (1- (point)))) - (when default-begin (setq default (buffer-substring-no-properties default-begin (1- (point))))) - ) + (when (not type-end) + (setq type-end (save-excursion (backward-char 1) (skip-syntax-backward " ") (point)))) (setq type (buffer-substring-no-properties type-begin type-end)) + + (when default-begin + (setq default (buffer-substring-no-properties default-begin (1- (point))))) + + (when (equal token 'RIGHT_PAREN) + (setq done t)) + (setq param (list (reverse identifiers) - in-p out-p not-null-p access-p constant-p protected-p + aliased-p in-p out-p not-null-p access-p constant-p protected-p type default)) - (if paramlist - (add-to-list 'paramlist param) - (setq paramlist (list param))) + (cl-pushnew param paramlist :test #'equal) (setq identifiers nil + aliased-p nil in-p nil out-p nil not-null-p nil @@ -1381,9 +1546,7 @@ Also return cache at start." (t (when (not type-begin) - (if identifiers - (add-to-list 'identifiers text) - (setq identifiers (list text))))) + (cl-pushnew text identifiers :test #'equal))) )) paramlist)) @@ -1410,9 +1573,9 @@ Also return cache at start." (wisi-validate-cache (point)) (save-excursion (let ((result nil) - (cache (ada-wisi-goto-declaration-start))) + (cache (condition-case nil (ada-wisi-goto-declaration-start) (error nil)))) (if (null cache) - ;; bob + ;; bob or failed parse (setq result "") (cl-case (wisi-cache-nonterm cache) @@ -1438,7 +1601,7 @@ Also return cache at start." (setq result (ada-wisi-which-function-1 "protected" t))) ((subprogram_declaration - subprogram_specification ;; after 'generic' + generic_subprogram_declaration ;; after 'generic' null_procedure_declaration) (setq result (ada-wisi-which-function-1 (wisi-cache-text (wisi-forward-find-token '(FUNCTION PROCEDURE) (point-max))) @@ -1461,11 +1624,96 @@ Also return cache at start." (interactive) (define-key ada-mode-map "\M-e" 'wisi-show-parse-error) (define-key ada-mode-map "\M-h" 'wisi-show-containing-or-previous-cache) - (define-key ada-mode-map "\M-i" 'wisi-goto-end) + (define-key ada-mode-map "\M-i" 'wisi-goto-statement-end) (define-key ada-mode-map "\M-j" 'wisi-show-cache) (define-key ada-mode-map "\M-k" 'wisi-show-token) ) +(defun ada-wisi-number-p (token-text) + "Return t if TOKEN-TEXT plus text after point matches the +syntax for a real literal; otherwise nil. point is after +TOKEN-TEXT; move point to just past token." + ;; test in test/wisi/ada-number-literal.input + ;; + ;; starts with a simple integer + (let ((end (point))) + ;; this first test must be very fast; it is executed for every token + (when (and (memq (aref token-text 0) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) + (string-match "^[0-9]+" token-text)) + (cond + ((= (char-after) ?#) + ;; based number + (forward-char 1) + (if (not (looking-at "[0-9a-fA-F]+")) + (progn (goto-char end) nil) + + (goto-char (match-end 0)) + (cond + ((= (char-after) ?#) + ;; based integer + (forward-char 1) + t) + + ((= (char-after) ?.) + ;; based real? + (forward-char 1) + (if (not (looking-at "[0-9a-fA-F]+")) + (progn (goto-char end) nil) + + (goto-char (match-end 0)) + + (if (not (= (char-after) ?#)) + (progn (goto-char end) nil) + + (forward-char 1) + (setq end (point)) + + (if (not (memq (char-after) '(?e ?E))) + ;; based real, no exponent + t + + ;; exponent? + (forward-char 1) + (if (not (looking-at "[+-]?[0-9]+")) + (progn (goto-char end) t) + + (goto-char (match-end 0)) + t + ))))) + + (t + ;; missing trailing # + (goto-char end) nil) + ))) + + ((= (char-after) ?.) + ;; decimal real number? + (forward-char 1) + (if (not (looking-at "[0-9]+")) + ;; decimal integer + (progn (goto-char end) t) + + (setq end (goto-char (match-end 0))) + + (if (not (memq (char-after) '(?e ?E))) + ;; decimal real, no exponent + t + + ;; exponent? + (forward-char 1) + (if (not (looking-at "[+-]?[0-9]+")) + (progn (goto-char end) t) + + (goto-char (match-end 0)) + t + )))) + + (t + ;; just an integer + t) + )) + )) + (defun ada-wisi-setup () "Set up a buffer for parsing Ada files with wisi." (wisi-setup '(ada-wisi-comment @@ -1480,58 +1728,22 @@ Also return cache at start." ;; Handle escaped quotes in strings (setq wisi-string-quote-escape-doubled t) - ;; Handle bracket notation for non-ascii characters in strings. This - ;; is actually more forgiving than that; it will treat - ;; '"foo["bar"]baz" as a single string. But that will be caught by - ;; the compiler, so it's ok for us. - (setq wisi-string-quote-escape '(?\" . ?\[ )) - (set (make-local-variable 'comment-indent-function) 'wisi-comment-indent) - - (add-hook 'hack-local-variables-hook 'ada-wisi-post-local-vars nil t) - ) - -(defun ada-wisi-post-local-vars () - ;; run after file local variables are read because font-lock-add-keywords - ;; evaluates font-lock-defaults, which depends on ada-language-version. - (font-lock-add-keywords 'ada-mode - ;; use keyword cache to distinguish between 'function ... return ;' and 'return ...;' - (list - (list - (concat - "\\<\\(" - "return[ \t]+access[ \t]+constant\\|" - "return[ \t]+access\\|" - "return" - "\\)\\>[ \t]*" - ada-name-regexp "?") - '(1 font-lock-keyword-face) - '(2 (if (eq (when (not (ada-in-string-or-comment-p)) - (wisi-validate-cache (match-end 2)) - (and (wisi-get-cache (match-beginning 2)) - (wisi-cache-class (wisi-get-cache (match-beginning 2))))) - 'type) - font-lock-type-face - 'default) - nil t) - ))) - - (when global-font-lock-mode - ;; ensure the modified keywords are applied - (font-lock-refresh-defaults)) ) (add-hook 'ada-mode-hook 'ada-wisi-setup) (setq ada-fix-context-clause 'ada-wisi-context-clause) -(setq ada-goto-declaration-start 'ada-wisi-goto-declaration-start) (setq ada-goto-declaration-end 'ada-wisi-goto-declaration-end) +(setq ada-goto-declaration-start 'ada-wisi-goto-declaration-start) (setq ada-goto-declarative-region-start 'ada-wisi-goto-declarative-region-start) -(setq ada-goto-end 'wisi-goto-end) +(setq ada-goto-end 'wisi-goto-statement-end) +(setq ada-goto-subunit-name 'ada-wisi-goto-subunit-name) (setq ada-in-paramlist-p 'ada-wisi-in-paramlist-p) (setq ada-indent-statement 'wisi-indent-statement) (setq ada-make-subprogram-body 'ada-wisi-make-subprogram-body) (setq ada-next-statement-keyword 'wisi-forward-statement-keyword) +(setq ada-on-context-clause 'ada-wisi-on-context-clause) (setq ada-prev-statement-keyword 'wisi-backward-statement-keyword) (setq ada-reset-parser 'wisi-invalidate-cache) (setq ada-scan-paramlist 'ada-wisi-scan-paramlist)