;;; 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 Free Software Foundation, Inc.
;; Author: Rolf Ebert <ebert@inf.enst.fr>
;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
(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"))
+ (let ((version-string "4.00"))
(if (interactive-p)
(message version-string)
version-string)))
(const ada-no-auto-case))
:group 'ada)
+;; FIXME If this is not something required by the ada language, this
+;; should be removed.
(defcustom ada-clean-buffer-before-saving t
"*Non-nil means remove trailing spaces and untabify the buffer before saving."
:type 'boolean :group 'ada)
(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)))
+ (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
;;;###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")
(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))
(interactive "P")
(if ada-auto-case
- (let ((lastk last-command-char)
+ (let ((lastk last-command-event)
(previous-syntax-table (syntax-table)))
(unwind-protect
;; 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-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))
(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
(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)
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'
;;
(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
(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))))
))
;; Mark single quotes as having string quote syntax in 'c' instances.
;; 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 . ?')))
("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))))
"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