;;; ada-mode.el --- major-mode for editing Ada sources
;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Rolf Ebert <ebert@inf.enst.fr>
;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This mode is a major mode for editing Ada code. This is a major
(require 'which-func nil t)
(require 'compile nil t)
-(defvar compile-auto-highlight)
(defvar ispell-check-comments)
(defvar skeleton-further-elements)
(defun ada-mode-version ()
"Return Ada mode version."
(interactive)
- (let ((version-string "3.7"))
- (if (interactive-p)
+ (let ((version-string "4.00"))
+ (if (called-interactively-p 'interactive)
(message version-string)
version-string)))
(defcustom ada-clean-buffer-before-saving t
"*Non-nil means remove trailing spaces and untabify the buffer before saving."
:type 'boolean :group 'ada)
+(make-obsolete-variable 'ada-clean-buffer-before-saving
+ "use the `write-file-functions' hook."
+ "23.2")
+
(defcustom ada-indent 3
"*Size of Ada indentation.
For instance:
A := 1; -- A multi-line comment
- -- aligned if ada-indent-align-comments is t"
+ -- aligned if `ada-indent-align-comments' is t"
:type 'boolean :group 'ada)
(defcustom ada-indent-comment-as-code t
(defvar ada-mode-map (make-sparse-keymap)
"Local keymap used for Ada mode.")
+(defvar ada-mode-extra-map (make-sparse-keymap)
+ "Keymap used for non-standard keybindings.")
+
+;; default is C-c C-q because it's free in ada-mode-map
+(defvar ada-mode-extra-prefix "\C-c\C-q"
+ "Prefix key to access `ada-mode-extra-map' functions.")
+
(defvar ada-mode-abbrev-table nil
"Local abbrev table for Ada mode.")
;; FIXME: make this customizable
(defconst ada-ident-re
- "\\(\\sw\\|[_.]\\)+"
- "Regexp matching Ada (qualified) identifiers.")
+ "[[:alpha:]]\\(?:[_[:alnum:]]\\)*"
+ ;; [:alnum:] matches any multibyte word constituent, as well as
+ ;; Latin-1 letters and numbers. This allows __ and trailing _;
+ ;; someone (emacs bug#1919) proposed [^\W_] to fix that, but \W does
+ ;; _not_ mean "not word constituent" inside a character alternative.
+ "Regexp matching an Ada identifier.")
+
+(defconst ada-goto-label-re
+ (concat "<<" ada-ident-re ">>")
+ "Regexp matching a goto label.")
+
+(defconst ada-block-label-re
+ (concat ada-ident-re "[ \t\n]*:[^=]")
+ "Regexp matching a block label.
+Note that this also matches a variable declaration.")
+
+(defconst ada-label-re
+ (concat "\\(?:" ada-block-label-re "\\)\\|\\(?:" ada-goto-label-re "\\)")
+ "Regexp matching a goto or block label.")
;; "with" needs to be included in the regexp, to match generic subprogram parameters
;; Similarly, we put '[not] overriding' on the same line with 'procedure' etc.
(concat "\\("
";" "\\|"
"=>[ \t]*$" "\\|"
+ "=>[ \t]*--.*$" "\\|"
"^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)" "\\|"
"\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
"loop" "private" "record" "select"
"\\>"))
"Regexp used in `ada-goto-matching-start'.")
-(defvar ada-matching-decl-start-re
- (eval-when-compile
- (concat "\\<"
- (regexp-opt
- '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
- "\\>"))
- "Regexp used in `ada-goto-matching-decl-start'.")
-
(defvar ada-loop-start-re
"\\<\\(for\\|while\\|loop\\)\\>"
"Regexp for the start of a loop.")
(defvar ada-subprog-start-re
(eval-when-compile
- (concat "\\<" (regexp-opt '("accept" "entry" "function" "package" "procedure"
+ (concat "\\<" (regexp-opt '("accept" "entry" "function" "overriding" "package" "procedure"
"protected" "task") t) "\\>"))
"Regexp for the start of a subprogram.")
-(defvar ada-named-block-re
- "[ \t]*\\(\\sw\\|_\\)+[ \t]*:[^=]"
- "Regexp of the name of a block or loop.")
-
(defvar ada-contextual-menu-on-identifier nil
"Set to true when the right mouse button was clicked on an identifier.")
(defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?")
(defconst ada-imenu-subprogram-menu-re
- (concat "^[ \t]*\\(procedure\\|function\\)[ \t\n]+"
+ (concat "^[ \t]*\\(overriding[ \t]*\\)?\\(procedure\\|function\\)[ \t\n]+"
"\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)"
ada-imenu-comment-re
"\\)[ \t\n]*"
(defvar ada-imenu-generic-expression
(list
- (list nil ada-imenu-subprogram-menu-re 2)
+ (list nil ada-imenu-subprogram-menu-re 3)
(list "*Specs*"
(concat
"^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)"
;; set source marker
(save-excursion
- (compilation-find-file (point-marker) (match-string 1) "./")
- (set-buffer file)
+ (compilation-find-file (point-marker) (match-string 1) "./")
+ (set-buffer file)
- (if (stringp line)
- (goto-line (string-to-number line)))
+ (when (stringp line)
+ (goto-char (point-min))
+ (forward-line (1- (string-to-number line))))
- (setq source (point-marker)))
+ (setq source (point-marker)))
(compilation-goto-locus error-pos source nil)
(buffer-undo-list t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- buffer-file-name buffer-file-truename)
+ (inhibit-modification-hooks t))
(remove-text-properties (point-min) (point-max) '(syntax-table nil))
(goto-char (point-min))
(while (re-search-forward
(line-beginning-position) (point))))
(or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
+(defsubst ada-in-numeric-literal-p ()
+ "Return t if point is after a prefix of a numeric literal."
+ (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)"))
;;------------------------------------------------------------------
;; Contextual menus
;;;###autoload
(defun ada-mode ()
- "Ada mode is the major mode for editing Ada code.
-
-Bindings are as follows: (Note: 'LFD' is control-j.)
-\\{ada-mode-map}
-
- Indent line '\\[ada-tab]'
- Indent line, insert newline and indent the new line. '\\[newline-and-indent]'
-
- Re-format the parameter-list point is in '\\[ada-format-paramlist]'
- Indent all lines in region '\\[ada-indent-region]'
-
- Adjust case of identifiers and keywords in region '\\[ada-adjust-case-region]'
- Adjust case of identifiers and keywords in buffer '\\[ada-adjust-case-buffer]'
-
- Fill comment paragraph, justify and append postfix '\\[fill-paragraph]'
-
- Next func/proc/task '\\[ada-next-procedure]' Previous func/proc/task '\\[ada-previous-procedure]'
- Next package '\\[ada-next-package]' Previous package '\\[ada-previous-package]'
-
- Goto matching start of current 'end ...;' '\\[ada-move-to-start]'
- Goto end of current block '\\[ada-move-to-end]'
-
-Comments are handled using standard GNU Emacs conventions, including:
- Start a comment '\\[indent-for-comment]'
- Comment region '\\[comment-region]'
- Uncomment region '\\[ada-uncomment-region]'
- Continue comment on next line '\\[indent-new-comment-line]'
-
-If you use imenu.el:
- Display index-menu of functions and procedures '\\[imenu]'
-
-If you use find-file.el:
- Switch to other file (Body <-> Spec) '\\[ff-find-other-file]'
- or '\\[ff-mouse-find-other-file]
- Switch to other file in other window '\\[ada-ff-other-window]'
- or '\\[ff-mouse-find-other-file-other-window]
- If you use this function in a spec and no body is available, it gets created with body stubs.
-
-If you use ada-xref.el:
- Goto declaration: '\\[ada-point-and-xref]' on the identifier
- or '\\[ada-goto-declaration]' with point on the identifier
- Complete identifier: '\\[ada-complete-identifier]'."
+ "Ada mode is the major mode for editing Ada code."
(interactive)
(kill-all-local-variables)
(set (make-local-variable 'fill-paragraph-function)
'ada-fill-comment-paragraph)
- (set (make-local-variable 'imenu-generic-expression)
- ada-imenu-generic-expression)
-
;; Support for compile.el
;; We just substitute our own functions to go to the error.
(add-hook 'compilation-mode-hook
(lambda()
- (set (make-local-variable 'compile-auto-highlight) 40)
;; FIXME: This has global impact! -stef
(define-key compilation-minor-mode-map [mouse-2]
'ada-compile-mouse-goto-error)
'ada-compile-goto-error)))
;; font-lock support :
- ;; We need to set some properties for XEmacs, and define some variables
- ;; for Emacs
- ;; FIXME: The Emacs code should work just fine under XEmacs AFAIK. --Stef
- (if (featurep 'xemacs)
- ;; XEmacs
- (put 'ada-mode 'font-lock-defaults
- '(ada-font-lock-keywords
- nil t ((?\_ . "w") (?# . ".")) beginning-of-line))
- ;; Emacs
- (set (make-local-variable 'font-lock-defaults)
- '(ada-font-lock-keywords
- nil t
- ((?\_ . "w") (?# . "."))
- beginning-of-line
- (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
- )
+ (set (make-local-variable 'font-lock-defaults)
+ '(ada-font-lock-keywords
+ nil t
+ ((?\_ . "w") (?# . "."))
+ beginning-of-line
+ (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
;; Set up support for find-file.el.
(set (make-local-variable 'ff-other-file-alist)
(make-local-variable 'ff-special-constructs)
(mapc (lambda (pair) (add-to-list 'ff-special-constructs pair))
- (list
- ;; Top level child package declaration; go to the parent package.
- (cons (eval-when-compile
- (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
- "\\(body[ \t]+\\)?"
- "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
- (lambda ()
- (ff-get-file
- ada-search-directories-internal
- (ada-make-filename-from-adaname (match-string 3))
- ada-spec-suffixes)))
-
- ;; A "separate" clause.
- (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
- (lambda ()
- (ff-get-file
- ada-search-directories-internal
- (ada-make-filename-from-adaname (match-string 1))
- ada-spec-suffixes)))
-
- ;; A "with" clause.
- (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
- (lambda ()
- (ff-get-file
- ada-search-directories-internal
- (ada-make-filename-from-adaname (match-string 1))
- ada-spec-suffixes)))
- ))
+ (list
+ ;; Top level child package declaration; go to the parent package.
+ (cons (eval-when-compile
+ (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
+ "\\(body[ \t]+\\)?"
+ "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
+ (lambda ()
+ (ff-get-file
+ ada-search-directories-internal
+ (ada-make-filename-from-adaname (match-string 3))
+ ada-spec-suffixes)))
+
+ ;; A "separate" clause.
+ (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
+ (lambda ()
+ (ff-get-file
+ ada-search-directories-internal
+ (ada-make-filename-from-adaname (match-string 1))
+ ada-spec-suffixes)))
+
+ ;; A "with" clause.
+ (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
+ (lambda ()
+ (ff-get-file
+ ada-search-directories-internal
+ (ada-make-filename-from-adaname (match-string 1))
+ ada-spec-suffixes)))
+ ))
;; Support for outline-minor-mode
(set (make-local-variable 'outline-regexp)
(set (make-local-variable 'outline-level) 'ada-outline-level)
;; Support for imenu : We want a sorted index
+ (setq imenu-generic-expression ada-imenu-generic-expression)
+
(setq imenu-sort-function 'imenu--sort-by-name)
;; Support for ispell : Check only comments
;; Exclude comments alone on line from alignment.
(add-to-list 'align-exclude-rules-list
- '(ada-solo-comment
- (regexp . "^\\(\\s-*\\)--")
- (modes . '(ada-mode))))
+ '(ada-solo-comment
+ (regexp . "^\\(\\s-*\\)--")
+ (modes . '(ada-mode))))
(add-to-list 'align-exclude-rules-list
- '(ada-solo-use
- (regexp . "^\\(\\s-*\\)\\<use\\>")
- (modes . '(ada-mode))))
+ '(ada-solo-use
+ (regexp . "^\\(\\s-*\\)\\<use\\>")
+ (modes . '(ada-mode))))
(setq ada-align-modes nil)
(add-to-list 'ada-align-modes
- '(ada-declaration-assign
- (regexp . "[^:]\\(\\s-*\\):[^:]")
- (valid . (lambda() (not (ada-in-comment-p))))
- (repeat . t)
- (modes . '(ada-mode))))
+ '(ada-declaration-assign
+ (regexp . "[^:]\\(\\s-*\\):[^:]")
+ (valid . (lambda() (not (ada-in-comment-p))))
+ (repeat . t)
+ (modes . '(ada-mode))))
(add-to-list 'ada-align-modes
- '(ada-associate
- (regexp . "[^=]\\(\\s-*\\)=>")
- (valid . (lambda() (not (ada-in-comment-p))))
- (modes . '(ada-mode))))
+ '(ada-associate
+ (regexp . "[^=]\\(\\s-*\\)=>")
+ (valid . (lambda() (not (ada-in-comment-p))))
+ (modes . '(ada-mode))))
(add-to-list 'ada-align-modes
- '(ada-comment
- (regexp . "\\(\\s-*\\)--")
- (modes . '(ada-mode))))
+ '(ada-comment
+ (regexp . "\\(\\s-*\\)--")
+ (modes . '(ada-mode))))
(add-to-list 'ada-align-modes
- '(ada-use
- (regexp . "\\(\\s-*\\)\\<use\\s-")
- (valid . (lambda() (not (ada-in-comment-p))))
- (modes . '(ada-mode))))
+ '(ada-use
+ (regexp . "\\(\\s-*\\)\\<use\\s-")
+ (valid . (lambda() (not (ada-in-comment-p))))
+ (modes . '(ada-mode))))
(add-to-list 'ada-align-modes
- '(ada-at
- (regexp . "\\(\\s-+\\)at\\>")
- (modes . '(ada-mode))))
+ '(ada-at
+ (regexp . "\\(\\s-+\\)at\\>")
+ (modes . '(ada-mode))))
(setq align-mode-rules-list ada-align-modes)
;; Support for indent-new-comment-line (Especially for XEmacs)
(set (make-local-variable 'comment-multi-line) nil)
+ ;; Support for add-log
+ (set (make-local-variable 'add-log-current-defun-function) 'ada-which-function)
+
(setq major-mode 'ada-mode
mode-name "Ada")
(set-syntax-table ada-mode-syntax-table)
- (if ada-clean-buffer-before-saving
- (progn
- ;; remove all spaces at the end of lines in the whole buffer.
- (add-hook 'local-write-file-hooks 'delete-trailing-whitespace)
- ;; convert all tabs to the correct number of spaces.
- (add-hook 'local-write-file-hooks
- (lambda () (untabify (point-min) (point-max))))))
-
(set (make-local-variable 'skeleton-further-elements)
'((< '(backward-delete-char-untabify
(min ada-indent (current-column))))))
(defun ada-create-case-exception (&optional word)
"Define WORD as an exception for the casing system.
If WORD is not given, then the current word in the buffer is used instead.
-The new words is added to the first file in `ada-case-exception-file'.
+The new word is added to the first file in `ada-case-exception-file'.
The standard casing rules will no longer apply to this word."
(interactive)
(let ((previous-syntax-table (syntax-table))
(eq (char-syntax (char-before)) ?w)
;; if in a string or a comment
(not (ada-in-string-or-comment-p))
+ ;; if in a numeric literal
+ (not (ada-in-numeric-literal-p))
)
(if (save-excursion
(forward-word -1)
(interactive "P")
(if ada-auto-case
- (let ((lastk last-command-char)
+ (let ((lastk last-command-event)
(previous-syntax-table (syntax-table)))
(unwind-protect
(insert " ")
(ada-adjust-case)
;; horrible dekludge
- (delete-backward-char 1)
+ (delete-char -1)
;; some special keys and their bindings
(cond
((eq lastk ?\n)
;; Else, no auto-casing
(cond
- ((eq last-command-char ?\n)
+ ((eq last-command-event ?\n)
(funcall ada-lfd-binding))
- ((eq last-command-char ?\r)
+ ((eq last-command-event ?\r)
(funcall ada-ret-binding))
(t
(self-insert-command (prefix-numeric-value arg))))
instance use it for `ada-case-identifier' if you don't want any special
auto-casing for identifiers, whereas keywords have to be lower-cased.
See also `ada-auto-case' to disable auto casing altogether."
- )
+ nil)
(defun ada-capitalize-word (&optional arg)
"Upcase first letter and letters following '_', lower case other letters.
(defun ada-indent-newline-indent-conditional ()
"Insert a newline and indent it.
-The original line is indented first if `ada-indent-after-return' is non-nil."
+The original line is re-indented if `ada-indent-after-return' is non-nil."
(interactive "*")
- (if ada-indent-after-return (ada-indent-current))
+ ;; If at end of buffer (entering brand new code), some indentation
+ ;; fails. For example, a block label requires whitespace following
+ ;; the : to be recognized. So we do the newline first, then
+ ;; go back and indent the original line.
(newline)
+ (if ada-indent-after-return
+ (progn
+ (forward-char -1)
+ (ada-indent-current)
+ (forward-char 1)))
(ada-indent-current))
(defun ada-justified-indent-current ()
(defun ada-batch-reformat ()
"Re-indent and re-case all the files found on the command line.
-This function should be used from the Unix/Windows command line, with a
+This function should be used from the command line, with a
command like:
emacs -batch -l ada-mode -f ada-batch-reformat file1 file2 ..."
(defun ada-indent-current ()
"Indent current line as Ada code.
-Return the calculation that was done, including the reference point and the
-offset."
+Return the calculation that was done, including the reference point
+and the offset."
(interactive)
(let ((previous-syntax-table (syntax-table))
(orgpoint (point-marker))
(progn
(goto-char (car match-cons))
(save-excursion
- (beginning-of-line)
- (if (looking-at ada-named-block-re)
+ (back-to-indentation)
+ (if (looking-at ada-block-label-re)
(setq label (- ada-label-indent))))))))
;; found 'record' =>
((and (= (downcase (char-after)) ?b)
(looking-at "begin\\>"))
(save-excursion
- (if (ada-goto-matching-decl-start t)
+ (if (ada-goto-decl-start t)
(list (progn (back-to-indentation) (point)) 0)
(ada-indent-on-previous-lines nil orgpoint orgpoint))))
(list (progn (back-to-indentation) (point)) 'ada-indent))
(save-excursion
(ada-goto-stmt-start)
- (if (looking-at "\\<package\\|procedure\\|function\\>")
+ (if (looking-at "\\<overriding\\|package\\|procedure\\|function\\>")
(list (progn (back-to-indentation) (point)) 0)
(list (progn (back-to-indentation) (point)) 'ada-indent)))))
(looking-at "\\<\\(package\\|function\\|procedure\\)\\>"))
(save-excursion
;; Go up until we find either a generic section, or the end of the
- ;; previous subprogram/package
+ ;; previous subprogram/package, or 'overriding' for this function/procedure
(let (found)
(while (and (not found)
(ada-search-ignore-string-comment
- "\\<\\(generic\\|end\\|begin\\|package\\|procedure\\|function\\)\\>" t))
+ "\\<\\(generic\\|end\\|begin\\|overriding\\|package\\|procedure\\|function\\)\\>" t))
;; avoid "with procedure"... in generic parts
(save-excursion
(forward-word -1)
(setq found (not (looking-at "with"))))))
- (if (looking-at "generic")
- (list (progn (back-to-indentation) (point)) 0)
- (ada-indent-on-previous-lines nil orgpoint orgpoint))))
+ (cond
+ ((looking-at "\\<generic\\|overriding\\>")
+ (list (progn (back-to-indentation) (point)) 0))
+
+ (t
+ (ada-indent-on-previous-lines nil orgpoint orgpoint)))))
;;---------------------------------
;; label
;;---------------------------------
- ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
+ ((looking-at ada-label-re)
(if (ada-in-decl-p)
+ ;; ada-block-label-re matches variable declarations
(ada-indent-on-previous-lines nil orgpoint orgpoint)
(append (ada-indent-on-previous-lines nil orgpoint orgpoint)
'(ada-label-indent))))
(if (ada-in-paramlist-p)
(ada-get-indent-paramlist)
- ;; move to beginning of current statement
+ ;; Move to beginning of current statement. If already at a
+ ;; statement start, move to beginning of enclosing statement.
(unless nomove
- (ada-goto-stmt-start))
+ (ada-goto-stmt-start t))
;; no beginning found => don't change indentation
(if (and (eq oldpoint (point))
((looking-at ada-block-start-re)
(ada-get-indent-block-start orgpoint))
;;
+ ((looking-at ada-block-label-re) ; also variable declaration
+ (ada-get-indent-block-label orgpoint))
+ ;;
+ ((looking-at ada-goto-label-re)
+ (ada-get-indent-goto-label orgpoint))
+ ;;
((looking-at "\\(sub\\)?type\\>")
(ada-get-indent-type orgpoint))
;;
((looking-at "when\\>")
(ada-get-indent-when orgpoint))
;;
- ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
- (ada-get-indent-label orgpoint))
- ;;
((looking-at "separate\\>")
(ada-get-indent-nochange))
-
- ;; A label
- ((looking-at "<<")
- (list (+ (save-excursion (back-to-indentation) (point))
- (- ada-label-indent))))
-
;;
((looking-at "with\\>\\|use\\>")
;; Are we still in that statement, or are we in fact looking at
(t
(goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
(ada-goto-next-non-ws)
- (list (point) 0)))))
+ (list (point) 'ada-broken-indent)))))
(defun ada-get-indent-end (orgpoint)
"Calculate the indentation when point is just before an end statement.
(forward-word 1)
(ada-goto-next-non-ws)
(cond
- ((looking-at "\\<\\(loop\\|select\\|if\\|case\\)\\>")
+ ;;
+ ;; loop/select/if/case/return
+ ;;
+ ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|return\\)\\>")
(save-excursion (ada-check-matching-start (match-string 0)))
(list (save-excursion (back-to-indentation) (point)) 0))
;;
- ;; loop/select/if/case/record/select
+ ;; record
;;
((looking-at "\\<record\\>")
(save-excursion
(if (looking-at "\\<begin\\>")
(progn
(setq indent (list (point) 0))
- (if (ada-goto-matching-decl-start t)
+ (if (ada-goto-decl-start t)
(list (progn (back-to-indentation) (point)) 0)
indent))
(list (progn (back-to-indentation) (point)) 0)
(car (ada-search-ignore-string-comment "\\<type\\>" t)))
'ada-indent)))
+ ;; Special case for label:
+ ((looking-at ada-block-label-re)
+ (list (- (save-excursion (back-to-indentation) (point)) ada-label-indent) 'ada-indent))
+
;; nothing follows the block-start
(t
(list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))
(list (save-excursion (back-to-indentation) (point))
'ada-broken-decl-indent))
- ;; This one is called in every over case when indenting a line at the
+ ;; This one is called in every other case when indenting a line at the
;; top level
(t
- (if (looking-at ada-named-block-re)
+ (if (looking-at (concat "[ \t]*" ada-block-label-re))
(setq label (- ada-label-indent))
(let (p)
(list (+ (save-excursion (back-to-indentation) (point)) label)
'ada-broken-indent)))))))
-(defun ada-get-indent-label (orgpoint)
+(defun ada-get-indent-block-label (orgpoint)
"Calculate the indentation when before a label or variable declaration.
ORGPOINT is the limit position used in the calculation."
(let ((match-cons nil)
(t
(list cur-indent '(- ada-label-indent))))))
+(defun ada-get-indent-goto-label (orgpoint)
+ "Calculate the indentation when at a goto label."
+ (search-forward ">>")
+ (ada-goto-next-non-ws)
+ (if (>= (point) orgpoint)
+ ;; labeled statement is the one we need to indent
+ (list (- (point) ada-label-indent))
+ ;; else indentation is indent for labeled statement
+ (ada-indent-on-previous-lines t orgpoint)))
+
(defun ada-get-indent-loop (orgpoint)
"Calculate the indentation when just before a loop or a for ... use.
ORGPOINT is the limit position used in the calculation."
;; If looking at a named block, skip the label
(label (save-excursion
- (beginning-of-line)
- (if (looking-at ada-named-block-re)
+ (back-to-indentation)
+ (if (looking-at ada-block-label-re)
(- ada-label-indent)
0))))
(setq pos (ada-get-indent-block-start orgpoint))
(if (equal label 0)
pos
- (list (+ (car pos) label) (cdr pos))))
+ (list (+ (car pos) label) (cadr pos))))
;;
;; 'for'- loop (or also a for ... use statement)
;; -- searching and matching
;; -----------------------------------------------------------
-(defun ada-goto-stmt-start ()
+(defun ada-goto-stmt-start (&optional ignore-goto-label)
"Move point to the beginning of the statement that point is in or after.
Return the new position of point.
As a special case, if we are looking at a closing parenthesis, skip to the
(progn
(unless (save-excursion
(goto-char (cdr match-dat))
- (ada-goto-next-non-ws orgpoint))
+ (ada-goto-next-non-ws orgpoint ignore-goto-label))
;;
;; nothing follows => it's the end-statement directly in
;; front of point => search again
(goto-char (point-min))
;;
;; skip to the very first statement, if there is one
- ;;
+ ;;
(unless (ada-goto-next-non-ws orgpoint)
(goto-char orgpoint))))
(point)))
match-dat
nil)))
-
-(defun ada-goto-next-non-ws (&optional limit)
- "Skip white spaces, newlines and comments to next non-ws character.
+(defun ada-goto-next-non-ws (&optional limit skip-goto-label)
+ "Skip to next non-whitespace character.
+Skips spaces, newlines and comments, and possibly goto labels.
+Return `point' if moved, nil if not.
Stop the search at LIMIT.
Do not call this function from within a string."
(unless limit
(setq limit (point-max)))
(while (and (<= (point) limit)
- (progn (forward-comment 10000)
- (if (and (not (eobp))
- (save-excursion (forward-char 1)
- (ada-in-string-p)))
- (progn (forward-sexp 1) t)))))
+ (or (progn (forward-comment 10000)
+ (if (and (not (eobp))
+ (save-excursion (forward-char 1)
+ (ada-in-string-p)))
+ (progn (forward-sexp 1) t)))
+ (and skip-goto-label
+ (looking-at ada-goto-label-re)
+ (progn
+ (goto-char (match-end 0))
+ t)))))
(if (< (point) limit)
(point)
nil)
(unless backward
(skip-syntax-forward "w"))
(if (setq match-cons
- (if backward
- (ada-search-ignore-string-comment "\\w" t nil t)
- (ada-search-ignore-string-comment "\\w" nil nil t)))
+ (ada-search-ignore-string-comment "\\w" backward nil t))
;;
;; move to the beginning of the word found
;;
Assumes point to be already positioned by `ada-goto-matching-start'.
Moves point to the beginning of the declaration."
- ;; named block without a `declare'
+ ;; named block without a `declare'; ada-goto-matching-start leaves
+ ;; point at start of 'begin' for a block.
(if (save-excursion
(ada-goto-previous-word)
(looking-at (concat "\\<" defun-name "\\> *:")))
- t ; do nothing
+ t ; name matches
+ ;; else
;;
;; 'accept' or 'package' ?
;;
(unless (looking-at ada-subprog-start-re)
- (ada-goto-matching-decl-start))
+ (ada-goto-decl-start))
;;
;; 'begin' of 'procedure'/'function'/'task' or 'declare'
;;
;; a named 'declare'-block ? => jump to the label
;;
(if (looking-at "\\<declare\\>")
- (backward-word 1)
+ (progn
+ (forward-comment -1)
+ (backward-word 1))
;;
;; no, => 'procedure'/'function'/'task'/'protected'
;;
(buffer-substring (point)
(progn (forward-sexp 1) (point))))))))
-(defun ada-goto-matching-decl-start (&optional noerror recursive)
- "Move point to the matching declaration start of the current 'begin'.
-If NOERROR is non-nil, it only returns nil if no match was found."
+(defun ada-goto-decl-start (&optional noerror)
+ "Move point to the declaration start of the current construct.
+If NOERROR is non-nil, return nil if no match was found;
+otherwise throw error."
(let ((nest-count 1)
+ (regexp (eval-when-compile
+ (concat "\\<"
+ (regexp-opt
+ '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
+ "\\>")))
;; first should be set to t if we should stop at the first
;; "begin" we encounter.
- (first (not recursive))
+ (first t)
(count-generic nil)
(stop-at-when nil)
)
;; search backward for interesting keywords
(while (and
(not (zerop nest-count))
- (ada-search-ignore-string-comment ada-matching-decl-start-re t))
+ (ada-search-ignore-string-comment regexp t))
;;
;; calculate nest-depth
;;
(if (looking-at "end")
(ada-goto-matching-start 1 noerror t)
- ;; (ada-goto-matching-decl-start noerror t)
(setq loop-again nil)
(unless (looking-at "begin")
(setq first t))
;;
((looking-at "is")
- ;; check if it is only a type definition, but not a protected
- ;; type definition, which should be handled like a procedure.
- (if (or (looking-at "is[ \t]+<>")
- (save-excursion
- (forward-comment -10000)
- (forward-char -1)
-
- ;; Detect if we have a closing parenthesis (Could be
- ;; either the end of subprogram parameters or (<>)
- ;; in a type definition
- (if (= (char-after) ?\))
- (progn
- (forward-char 1)
- (backward-sexp 1)
- (forward-comment -10000)
- ))
- (skip-chars-backward "a-zA-Z0-9_.'")
- (ada-goto-previous-word)
- (and
- (looking-at "\\<\\(sub\\)?type\\|case\\>")
+ ;; look for things to ignore
+ (if
+ (or
+ ;; generic formal parameter
+ (looking-at "is[ t]+<>")
+
+ ;; A type definition, or a case statement. Note that the
+ ;; goto-matching-start above on 'end record' leaves us at
+ ;; 'record', not at 'type'.
+ ;;
+ ;; We get to a case statement here by calling
+ ;; 'ada-move-to-end' from inside a case statement; then
+ ;; we are not ignoring 'when'.
+ (save-excursion
+ ;; Skip type discriminants or case argument function call param list
+ (forward-comment -10000)
+ (forward-char -1)
+ (if (= (char-after) ?\))
+ (progn
+ (forward-char 1)
+ (backward-sexp 1)
+ (forward-comment -10000)
+ ))
+ ;; skip type or case argument name
+ (skip-chars-backward "a-zA-Z0-9_.'")
+ (ada-goto-previous-word)
+ (and
+ ;; if it's a protected type, it's the decl start we
+ ;; are looking for; since we didn't see the 'end'
+ ;; above, we are inside it.
+ (looking-at "\\<\\(sub\\)?type\\|case\\>")
(save-match-data
(ada-goto-previous-word)
(not (looking-at "\\<protected\\>"))))
- )) ; end of `or'
- (goto-char (match-beginning 0))
- (progn
- (setq nest-count (1- nest-count))
- (setq first nil))))
+ ) ; end of type definition p
+
+ ;; null procedure declaration
+ (save-excursion (ada-goto-next-word) (looking-at "\\<null\\>"))
+ );; end or
+ ;; skip this construct
+ nil
+ ;; this is the right "is"
+ (setq nest-count (1- nest-count))
+ (setq first nil)))
;;
((looking-at "new")
(goto-char (match-beginning 0)))
;;
- ;; found 'do' => skip back to 'accept'
+ ;; found 'do' => skip back to 'accept' or 'return'
;;
((looking-at "do")
(unless (ada-search-ignore-string-comment
- "accept" t nil nil
- 'word-search-backward)
- (error "Missing 'accept' in front of 'do'"))))
+ "\\<accept\\|return\\>" t)
+ (error "Missing 'accept' or 'return' in front of 'do'"))))
(point))
(if noerror
Assumes point to be at the end of a statement."
(or (ada-in-paramlist-p)
(save-excursion
- (ada-goto-matching-decl-start t))))
+ (ada-goto-decl-start t))))
(defun ada-looking-at-semi-or ()
(defun ada-in-paramlist-p ()
- "Return t if point is inside a parameter-list."
+ "Return t if point is inside the parameter-list of a declaration, but not a subprogram call or aggregate."
(save-excursion
(and
(ada-search-ignore-string-comment "(\\|)" t nil t)
;; right keyword two words before parenthesis ?
;; Type is in this list because of discriminants
+ ;; pragma is not, because the syntax is that of a subprogram call.
(looking-at (eval-when-compile
(concat "\\<\\("
"procedure\\|function\\|body\\|"
"task\\|entry\\|accept\\|"
"access[ \t]+procedure\\|"
"access[ \t]+function\\|"
- "pragma\\|"
"type\\)\\>"))))))
(defun ada-search-ignore-complex-boolean (regexp backwardp)
;;
ada-move-to-declaration
(looking-at "\\<begin\\>")
- (ada-goto-matching-decl-start)
+ (ada-goto-decl-start)
(setq pos (point))))
) ; end of save-excursion
(set-syntax-table previous-syntax-table))))
(defun ada-move-to-end ()
- "Move point to the matching end of the block around point.
+ "Move point to the end of the block around point.
Moves to 'begin' if in a declarative part."
(interactive)
(let ((pos (point))
(ada-goto-matching-end 0))
;; package start
((save-excursion
- (setq decl-start (and (ada-goto-matching-decl-start t) (point)))
+ (setq decl-start (and (ada-goto-decl-start t) (point)))
(and decl-start (looking-at "\\<package\\>")))
(ada-goto-matching-end 1))
(defun ada-create-keymap ()
"Create the keymap associated with the Ada mode."
+ ;; All non-standard keys go into ada-mode-extra-map
+ (define-key ada-mode-map ada-mode-extra-prefix ada-mode-extra-map)
+
;; Indentation and Formatting
(define-key ada-mode-map "\C-j" 'ada-indent-newline-indent-conditional)
(define-key ada-mode-map "\C-m" 'ada-indent-newline-indent-conditional)
'ada-point-and-xref)
(define-key ada-mode-map [(control tab)] 'ada-complete-identifier)
- (define-key ada-mode-map "\C-co" 'ff-find-other-file)
+ (define-key ada-mode-extra-map "o" 'ff-find-other-file)
(define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame)
(define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration)
(define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference)
(define-key ada-mode-map "\C-c\C-c" 'ada-compile-application)
- (define-key ada-mode-map "\C-cc" 'ada-change-prj)
- (define-key ada-mode-map "\C-cd" 'ada-set-default-project-file)
- (define-key ada-mode-map "\C-cg" 'ada-gdb-application)
+ (define-key ada-mode-extra-map "c" 'ada-change-prj)
+ (define-key ada-mode-extra-map "d" 'ada-set-default-project-file)
+ (define-key ada-mode-extra-map "g" 'ada-gdb-application)
(define-key ada-mode-map "\C-c\C-m" 'ada-set-main-compile-application)
- (define-key ada-mode-map "\C-cr" 'ada-run-application)
+ (define-key ada-mode-extra-map "r" 'ada-run-application)
(define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent)
(define-key ada-mode-map "\C-c\C-r" 'ada-find-references)
- (define-key ada-mode-map "\C-cl" 'ada-find-local-references)
+ (define-key ada-mode-extra-map "l" 'ada-find-local-references)
(define-key ada-mode-map "\C-c\C-v" 'ada-check-current)
- (define-key ada-mode-map "\C-cf" 'ada-find-file)
+ (define-key ada-mode-extra-map "f" 'ada-find-file)
- (define-key ada-mode-map "\C-cu" 'ada-prj-edit)
+ (define-key ada-mode-extra-map "u" 'ada-prj-edit)
+
+ (define-key ada-mode-map "\C-xnd" 'ada-narrow-to-defun); override narrow-to-defun
;; The templates, defined in ada-stmt.el
(define-key map "w" 'ada-while-loop)
(define-key map "\C-x" 'ada-exception)
(define-key map "x" 'ada-exit)
- (define-key ada-mode-map "\C-ct" map))
+ (define-key ada-mode-extra-map "t" map))
)
(save-excursion
(end-of-line);; make sure we get the complete name
(or (if (re-search-backward ada-procedure-start-regexp nil t)
- (setq ff-function-name (match-string 5)))
- (if (re-search-backward ada-package-start-regexp nil t)
- (setq ff-function-name (match-string 4))))
+ (setq ff-function-name (match-string 5)))
+ (if (re-search-backward ada-package-start-regexp nil t)
+ (setq ff-function-name (match-string 4))))
))
;; Get the function name, but not the properties, or this changes
;; the face in the modeline on Emacs 21
- (setq func-name (match-string-no-properties 2))
+ (setq func-name (match-string-no-properties 3))
(if (and (not (ada-in-comment-p))
(not (save-excursion
(goto-char (match-end 0))
(defconst ada-font-lock-syntactic-keywords
;; Mark single quotes as having string quote syntax in 'c' instances.
- ;; As a special case, ''' will not be highlighted, but if we do not
- ;; set this special case, then the rest of the buffer is highlighted as
- ;; a string
+ ;; We used to explicitly avoid ''' as a special case for fear the buffer
+ ;; be highlighted as a string, but it seems this fear is unfounded.
+ ;;
;; This sets the properties of the characters, so that ada-in-string-p
;; correctly handles '"' too...
- '(("[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
+ '(("[^a-zA-Z0-9)]\\('\\)[^\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))))
(defvar ada-font-lock-keywords
"null" "or" "others" "overriding" "private" "protected" "raise"
"range" "record" "rem" "renames" "requeue" "return" "reverse"
"select" "separate" "synchronized" "tagged" "task" "terminate"
- "then" "until" "when" "while" "with" "xor") t)
+ "then" "until" "when" "while" "with" "xor") t)
"\\>")
;;
;; Anything following end and not already fontified is a body name.
(insert "end " procname ";")
(ada-indent-newline-indent)
)
- ;; else
+
((looking-at "[ \t\n]*is")
;; do nothing
)
+
((looking-at "[ \t\n]*rename")
;; do nothing
)
+
(t
(message "unknown syntax"))))
(t
(autoload 'ada-point-and-xref "ada-xref" nil t)
(autoload 'ada-reread-prj-file "ada-xref" nil t)
(autoload 'ada-run-application "ada-xref" nil t)
-(autoload 'ada-set-default-project-file "ada-xref" nil nil)
(autoload 'ada-set-default-project-file "ada-xref" nil t)
(autoload 'ada-xref-goto-previous-reference "ada-xref" nil t)
(autoload 'ada-set-main-compile-application "ada-xref" nil t)
HCoop / bpt / emacs.git / blobdiff