;; 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
(defun ada-mode-version ()
"Return Ada mode version."
(interactive)
- (let ((version-string "3.7"))
+ (let ((version-string "4.00"))
(if (interactive-p)
(message version-string)
version-string)))
(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.")
(concat "\\("
";" "\\|"
"=>[ \t]*$" "\\|"
+ "=>[ \t]*--.*$" "\\|"
"^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)" "\\|"
"\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
"loop" "private" "record" "select"
;; 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)))
+ (if (stringp line)
+ (goto-line (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
(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
'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")
(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))
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-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))
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
+ ;; else
;;
;; 'accept' or 'package' ?
;;
;; 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'
;;
(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)
;; 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))))
))
(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)