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."
(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
;;
;; type Limited_Derived_Type_1d is
;; abstract limited new Private_Type_1 with
- ;; record
+ ;; record
;; indenting 'record'
;;
;; for Record_Type_1 use
(close-paren (wisi-indent-paren 0))
+ (keyword
+ ;; defer to after-cache)
+ nil)
+
(name
- (cl-case (wisi-cache-nonterm cache)
- ((procedure_specification subprogram_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))
;; (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)
;; (Local_2 = 1)
(+ (ada-wisi-current-indentation) ada-indent-broken))
- (name
+ ((IDENTIFIER selected_component name)
;; test/indent.ads
;; CSCL_Type'
;; (
;; (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
(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
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)))
+ (statement-start
+ (cl-case (wisi-cache-token cache)
+ (WITH ;; with_clause
+ (+ (current-column) ada-indent-with))
- (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))
- ))
- )))
- ))
+ (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-functions'."
+ "Compute indentation of a comment. For `wisi-indent-calculate-functions'."
;; We know we are at the first token on a line. We check for comment
;; syntax, not comment-start, to accomodate gnatprep, skeleton
;; placeholders, etc.
(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))
(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
)
cache))
+(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
(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)
(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)
(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
(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)
(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
(t
(when (not type-begin)
- (if identifiers
- (add-to-list 'identifiers text)
- (setq identifiers (list text)))))
+ (cl-pushnew text identifiers :test #'equal)))
))
paramlist))
(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)
(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)))
(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
;; 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 <type>;' 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-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)