;;
;; [1] ISO/IEC 8652:2012(E); Ada 2012 reference manual
;;
-;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012 - 2014 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@member.fsf.org>
;;
;;
;; implementation started Jan 2013
;;
-;;; code style
-;;
-;; not using lexical-binding or cl-lib because we support Emacs 23
-;;
;;;;
(require 'ada-fix-error)
(require 'ada-grammar-wy)
(require 'ada-indent-user-options)
+(require 'cl-lib)
(require 'wisi)
-(eval-when-compile (require 'cl-macs))
-
(defconst ada-wisi-class-list
'(
block-end
;;;; indentation
+(defun ada-wisi-current-indentation ()
+ "Return indentation of current line, incremented by 1 if starts with open-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))
+ ))))
+
(defun ada-wisi-indent-cache (offset cache)
"Return indentation of OFFSET plus indentation of line containing point. Point must be at CACHE."
(let ((indent (current-indentation)))
;; then -1
;; indenting 'then'; offset = 0
;;
- ;; need get-start, not just get-containing, because of:
;; L1 : Integer := (case J is
;; when 42 => -1,
;;
- ;; _not_ (ada-in-paren-p), because of:
;; test/indent.ads
;; C_S_Controls : constant
;; CSCL_Type :=
))
)))
+(defun ada-wisi-indent-list-break (cache prev-token)
+ "Return indentation for a token contained by CACHE, which must be a list-break.
+point must be on CACHE. PREV-TOKEN is the token before the one being indented."
+ (let ((break-point (point))
+ (containing (wisi-goto-containing cache)))
+ (cl-ecase (wisi-cache-token containing)
+ (LEFT_PAREN
+ (if (equal break-point (cl-caddr prev-token))
+ ;; we are indenting the first token after the list-break; not hanging.
+ ;;
+ ;; test/parent.adb
+ ;; Append_To (Formals,
+ ;; Make_Parameter_Specification (Loc,
+ ;; indenting 'Make_...'
+ ;;
+ ;; test/ada_mode-generic_instantiation.ads
+ ;; function Function_1 is new Instance.Generic_Function
+ ;; (Param_Type => Integer,
+ ;; Result_Type => Boolean,
+ ;; Threshold => 2);
+ ;; indenting 'Result_Type'
+ (+ (current-column) 1)
+ ;; else hanging
+ ;;
+ ;; test/ada_mode-parens.adb
+ ;; A :=
+ ;; (1 |
+ ;; 2 => (1, 1, 1),
+ ;; 3 |
+ ;; 4 => (2, 2, 2));
+ ;; indenting '4 =>'
+ (+ (current-column) 1 ada-indent-broken)))
+
+ (IS
+ ;; test/ada_mode-conditional_expressions.adb
+ ;; L1 : Integer := (case J is
+ ;; when 42 => -1,
+ ;; -- comment aligned with 'when'
+ ;; indenting '-- comment'
+ (wisi-indent-paren (+ 1 ada-indent-when)))
+
+ (WITH
+ (cl-ecase (wisi-cache-nonterm containing)
+ (aggregate
+ ;; test/ada_mode-nominal-child.ads
+ ;; (Default_Parent with
+ ;; Child_Element_1 => 10,
+ ;; Child_Element_2 => 12.0,
+ ;; indenting 'Child_Element_2'
+ (wisi-indent-paren 1))
+
+ (aspect_specification_opt
+ ;; test/aspects.ads:
+ ;; type Vector is tagged private
+ ;; with
+ ;; Constant_Indexing => Constant_Reference,
+ ;; Variable_Indexing => Reference,
+ ;; indenting 'Variable_Indexing'
+ (+ (current-indentation) ada-indent-broken))
+ ))
+ )
+ ))
+
(defun ada-wisi-before-cache ()
"Point is at indentation, before a cached token. Return new indentation for point."
(let ((pos-0 (point))
- (cache (wisi-get-cache (point))))
+ (cache (wisi-get-cache (point)))
+ (prev-token (save-excursion (wisi-backward-token)))
+ )
(when cache
(cl-ecase (wisi-cache-class cache)
(block-start
(ada-wisi-indent-containing 0 cache t))
(RECORD
- (ada-wisi-indent-containing ada-indent-record-rel-type cache t))
+ ;; test/ada_mode-nominal.ads; ada-indent-record-rel-type = 3
+ ;; type Private_Type_2 is abstract tagged limited
+ ;; record
+ ;; indenting 'record'
+ ;;
+ ;; type Limited_Derived_Type_1d is
+ ;; abstract limited new Private_Type_1 with
+ ;; record
+ ;; indenting 'record'
+ ;;
+ ;; for Record_Type_1 use
+ ;; record
+ ;; indenting 'record'
+ (let ((containing (wisi-goto-containing cache)))
+ (while (not (memq (wisi-cache-token containing) '(FOR TYPE)))
+ (setq containing (wisi-goto-containing containing)))
+ (+ (current-column) ada-indent-record-rel-type)))
(t ;; other
(ada-wisi-indent-containing ada-indent cache t))))
(close-paren (wisi-indent-paren 0))
(name
- (ada-wisi-indent-containing ada-indent-broken cache t))
+ (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))
- (name-paren
- (let ((containing (wisi-goto-containing cache)))
- (cl-case (wisi-cache-class containing)
- (open-paren
- ;; test/ada_mode-slices.adb
- ;; Put_Line(Day'Image(D1) & " - " & Day'Image(D2) & " = " &
- ;; Integer'Image(N));
- ;;
- ;; test/ada_mode-parens.adb
- ;; return Float (
- ;; Integer'Value
- ;; indenting 'Integer'
- ;;
- ;; We distinguish the two cases by going to the first token,
- ;; and comparing point to pos-0.
- (let ((paren-column (current-column)))
- (wisi-forward-token t); "("
- (forward-comment (point-max))
- (if (= (point) pos-0)
- ;; 2)
- (1+ paren-column)
- ;; 1)
- (+ paren-column 1 ada-indent-broken))))
-
- (list-break
- ;; test/parent.adb
- ;; Append_To (Formals,
- ;; Make_Parameter_Specification (Loc,
- (wisi-indent-paren 1))
+ (t
+ ;; defer to ada-wisi-after-cache, for consistency
+ nil)
+ ))
- (t
- ;; 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-cache ada-indent-broken containing))
- )))
+ (name-paren
+ ;; defer to ada-wisi-after-cache, for consistency
+ nil)
(open-paren
(let ((containing (wisi-goto-containing cache)))
;; RX_Enable =>
;; (RX_Torque_Subaddress |
;; indenting (RX_Torque
- (ada-wisi-indent-containing (1- ada-indent) containing t))
+ (ada-wisi-indent-containing ada-indent-broken containing t))
(LEFT_PAREN
;; test/ada_mode-parens.adb
;; (1 =>
;; indenting (D
(+ (current-column) 1 ada-indent-broken))
+ (WHEN
+ ;; test/ada_mode-nominal.adb
+ ;;
+ ;; when Local_1 = 0 and not
+ ;; (Local_2 = 1)
+ ;; indenting (Local_2
+ ;;
+ ;; entry E3
+ ;; (X : Integer) when Local_1 = 0 and not
+ ;; (Local_2 = 1)
+ (+ (ada-wisi-current-indentation) ada-indent-broken))
+
(name
;; test/indent.ads
;; CSCL_Type'
;; (1),
;; A(2));
;; indenting (1)
- (+ (current-indentation) ada-indent-broken))
+ ;;
+ ;; test/ada_mode-parens.adb
+ ;; Local_11 : Local_11_Type := Local_11_Type'
+ ;; (A => Integer
+ ;; (1.0),
+ ;; B => Integer
+ ;; (2.0));
+ (+ (ada-wisi-current-indentation) ada-indent-broken))
(t
(cond
;; indenting (X
(ada-wisi-indent-cache ada-indent-broken containing))
- ((and
- (eq (wisi-cache-nonterm containing) 'entry_body)
- (eq (wisi-cache-token containing) 'WHEN))
- ;; test/ada_mode-nominal.adb
- ;; when Local_1 = 0 and not
- ;; (Local_2 = 1)
- ;; indenting (Local_2
- (+ (current-column) ada-indent-broken))
-
(t
;; Open paren in an expression.
;;
;; 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)))
- (+ (current-column) ada-indent-broken))
+
+ (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
(+ (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 :=
((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
))
(list-break
- ;; test/ada_mode-generic_instantiation.ads
- ;; function Function_1 is new Instance.Generic_Function
- ;; (Param_Type => Integer,
- ;; Result_Type => Boolean,
- ;; Threshold => 2);
- ;; indenting 'Result_Type'
- (wisi-indent-paren 1))
+ (ada-wisi-indent-list-break cache prev-token))
(statement-other
- (cl-case (wisi-cache-token containing-cache)
- (LEFT_PAREN
- ;; test/ada_mode-parens.adb
- ;; return Float (
- ;; Integer'Value
- ;; indenting 'Integer'
- (wisi-indent-paren 1))
-
- (EQUAL_GREATER
- ;; test/ada_mode-nested_packages.adb
- ;; exception
- ;; when Io.Name_Error =>
- ;; null;
- (ada-wisi-indent-containing ada-indent containing-cache t))
-
- (t
- ;; test/ada_mode-generic_instantiation.ads
- ;; procedure Procedure_6 is new
- ;; Instance.Generic_Procedure (Integer, Function_1);
- ;; indenting 'Instance'
- (ada-wisi-indent-containing ada-indent-broken cache t))
- ))
+ ;; defer to ada-wisi-after-cache
+ nil)
))))
))
;; 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
- (save-excursion
- (let ((break-point (point))
- (containing (wisi-goto-containing cache)))
- (cl-ecase (wisi-cache-token containing)
- (LEFT_PAREN
- (let*
- ((list-element-token (wisi-cache-token (save-excursion (wisi-forward-cache))))
- (indent
- (cl-case list-element-token
- (WHEN ada-indent-when)
- (t 0))))
- (if (equal break-point (cl-caddr prev-token))
- ;; we are indenting the first token after the list-break; not hanging.
- (+ (current-column) 1 indent)
- ;; else hanging
- (+ (current-column) 1 ada-indent-broken indent))))
-
- (IS
- ;; ada_mode-conditional_expressions.adb
- ;; L1 : Integer := (case J is
- ;; when 42 => -1,
- ;; -- comment aligned with 'when'
- ;; indenting '-- comment'
- (wisi-indent-paren (+ 1 ada-indent-when)))
-
- (WITH
- (cl-ecase (wisi-cache-nonterm containing)
- (aggregate
- ;; ada_mode-nominal-child.ads
- ;; (Default_Parent with
- ;; Child_Element_1 => 10,
- ;; Child_Element_2 => 12.0,
- (wisi-indent-paren 1))
- ))
- ))))
+ (ada-wisi-indent-list-break cache prev-token))
(open-paren
;; 1) A parenthesized expression, or the first item in an aggregate:
;; -- 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
;; Please_Abort;
;; then
;; abort
- ;; -- 'abort' indented with ada-broken-indent, since this is part
+ ;; -- 'abort' indented with ada-indent-broken, since this is part
;; Titi;
(ada-wisi-indent-containing ada-indent cache))
(ada-wisi-indent-cache ada-indent-broken cache))
(EQUAL_GREATER
- (cl-ecase (wisi-cache-nonterm (wisi-goto-containing cache nil))
- (actual_parameter_part
- ;; 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'
- (+ (current-column) 1 ada-indent-broken))
-
- (association_list
- ;; test/ada_mode-parens.adb
- ;; (1 => 1,
- ;; 2 =>
- ;; 1 + 2 * 3,
- ;; point is on ','
- (wisi-indent-paren (1+ ada-indent-broken)))
-
- ((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))
+ (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)))
- (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))
+ (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))
+
+ (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))
+
+ (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))
;; 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))
+
+ (OF
+ ;; ada_mode-nominal.ads
+ ;; Anon_Array_2 : array (1 .. 10) of
+ ;; Integer;
(ada-wisi-indent-containing ada-indent-broken cache))
(WHEN
(ada-wisi-indent-containing ada-indent-broken cache))
(WITH
- ;; extension aggregate: test/ada_mode-nominal-child.ads
- ;; (Default_Parent with
- ;; 10, 12.0, True);
- ;; indenting '10'; containing is '('
- ;;
- ;; raise_statement: test/ada_mode-nominal.adb
- ;; raise Constraint_Error with
- ;; "help!";
(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))
- (raise_statement
- (ada-wisi-indent-containing ada-indent-broken 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))
))
;; otherwise just hanging
))
(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.
- (when (= 11 (syntax-class (syntax-after (point))))
+ (when (and (not (= (point) (point-max))) ;; no char after EOB!
+ (= 11 (syntax-class (syntax-after (point)))))
;; We are at a comment; indent to previous code or comment.
(cond
)
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))
ada-grammar-wy--keyword-table
ada-grammar-wy--token-table
ada-grammar-wy--parse-table)
+
+ ;; 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)
(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-declarative-region-start 'ada-wisi-goto-declarative-region-start)
(setq ada-goto-end 'wisi-goto-end)
(setq ada-in-paramlist-p 'ada-wisi-in-paramlist-p)