;;; ada-mode.el --- major-mode for editing Ada sources
-;; Copyright (C) 1994, 95, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1994, 95, 97, 98, 99, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Rolf Ebert <ebert@inf.enst.fr>
;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
;; Emmanuel Briot <briot@gnat.com>
;; Maintainer: Emmanuel Briot <briot@gnat.com>
-;; Ada Core Technologies's version: $Revision: 1.49 $
+;; Ada Core Technologies's version: Revision: 1.164.2.2 (GNAT 3.15)
;; Keywords: languages ada
;; This file is part of GNU Emacs.
;; This call should not be made in the release that is done for the
;; official Emacs, since it does nothing useful for the latest version
-(if (not (ada-check-emacs-version 21 1))
- (require 'ada-support))
+;; (if (not (ada-check-emacs-version 21 1))
+;; (require 'ada-support))
(defvar ada-mode-hook nil
"*List of functions to call when Ada mode is invoked.
>>>>>>>>>Value); -- from ada-broken-indent"
:type 'integer :group 'ada)
+(defcustom ada-continuation-indent ada-broken-indent
+ "*Number of columns to indent the continuation of broken lines in
+parenthesis.
+
+An example is :
+ Func (Param1,
+ >>>>>Param2);"
+ :type 'integer :group 'ada)
+
(defcustom ada-case-attribute 'ada-capitalize-word
"*Function to call to adjust the case of Ada attributes.
It may be `downcase-word', `upcase-word', `ada-loose-case-word',
An example is:
procedure Foo is
begin
->>>>>>>>>>>>Label: -- from ada-label-indent"
+>>>>>>>>>>>>Label: -- from ada-label-indent
+
+This is also used for <<..>> labels"
:type 'integer :group 'ada)
(defcustom ada-language-version 'ada95
:included (functionp 'ada-xref-goto-previous-reference)]
["List References" ada-find-references
:included ada-contextual-menu-on-identifier]
+ ["List Local References" ada-find-local-references
+ :included ada-contextual-menu-on-identifier]
["-" nil nil]
["Other File" ff-find-other-file]
["Goto Parent Unit" ada-goto-parent]
'(menu-item "List References"
ada-find-references
:visible ada-contextual-menu-on-identifier) t)
+ (define-key-after map [List-Local]
+ '(menu-item "List Local References"
+ ada-find-local-references
+ :visible ada-contextual-menu-on-identifier) t)
(define-key-after map [-] '("-" nil) t)
))
(define-key-after map [Other] '("Other file" . ff-find-other-file) t)
;; Setting this only if font-lock is not set won't work
;; if the user activates or deactivates font-lock-mode,
;; but will make things faster most of the time
+ (make-local-hook 'after-change-functions)
(add-hook 'after-change-functions 'ada-after-change-function nil t)
)))
;;;###autoload
(defun ada-mode ()
"Ada mode is the major mode for editing Ada code.
-This version was built on $Date: 2002/04/09 18:50:17 $.
+This version was built on Date: 2002/05/21 11:58:02 .
Bindings are as follows: (Note: 'LFD' is control-j.)
\\{ada-mode-map}
(progn
(add-to-list 'align-dq-string-modes 'ada-mode)
(add-to-list 'align-open-comment-modes 'ada-mode)
- (set 'align-mode-rules-list ada-align-modes)
(set (make-variable-buffer-local 'align-region-separate)
ada-align-region-separate)
- ))
- ;; Support for which-function-mode is provided in ada-support (support
- ;; for nested subprograms)
+ ;; Exclude comments alone on line from alignment.
+ (add-to-list 'align-exclude-rules-list
+ '(ada-solo-comment
+ (regexp . "^\\(\\s-*\\)--")
+ (modes . '(ada-mode))))
+ (add-to-list 'align-exclude-rules-list
+ '(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))))
+ (add-to-list 'ada-align-modes
+ '(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))))
+ (add-to-list 'ada-align-modes
+ '(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))))
+
+ (setq align-mode-rules-list ada-align-modes)
+ ))
+
;; Set up the contextual menu
(if ada-popup-key
(define-key ada-mode-map ada-popup-key 'ada-popup-menu))
(define-abbrev-table 'ada-mode-abbrev-table ())
(setq local-abbrev-table ada-mode-abbrev-table)
+ ;; Support for which-function mode
+ ;; which-function-mode does not work with nested subprograms, since it is
+ ;; based only on the regexps generated by imenu, and thus can only detect the
+ ;; beginning of subprograms, not the end.
+ ;; Fix is: redefine a new function ada-which-function, and call it when the
+ ;; major-mode is ada-mode.
+
+ (unless ada-xemacs
+ ;; This function do not require that we load which-func now.
+ ;; This can be done by the user if he decides to use which-func-mode
+
+ (defadvice which-function (around ada-which-function activate)
+ "In Ada buffers, should work with overloaded subprograms, and does not
+use imenu."
+ (if (equal major-mode 'ada-mode)
+ (set 'ad-return-value (ada-which-function))
+ ad-do-it))
+
+ ;; So that we can activate which-func-modes for Ada mode
+ (if (and (boundp 'which-func-modes)
+ (listp which-func-modes))
+ (add-to-list 'which-func-modes 'ada-mode))
+ )
+
;; Support for indent-new-comment-line (Especially for XEmacs)
(setq comment-multi-line nil)
(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)
+ (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))))))
(let ((line (save-excursion
(goto-char (car cur-indent))
- (count-lines (point-min) (point)))))
+ (count-lines 1 (point)))))
(if (equal (cdr cur-indent) '(0))
(message (concat "same indentation as line " (number-to-string line)))
;; ??? Could use a different variable
(list column 'ada-broken-indent)
- ;; Correctly indent named parameter lists ("name => ...") for
- ;; all the following lines
- (goto-char column)
- (if (and (progn (forward-comment 1000)
- (looking-at "\\sw+\\s *=>"))
- (progn (goto-char orgpoint)
- (forward-comment 1000)
- (not (looking-at "\\sw+\\s *=>"))))
- (list column 'ada-broken-indent)
-
- ;; ??? Would be nice that lines like
- ;; A
- ;; (B,
- ;; C
- ;; (E)); -- would be nice if this was correctly indented
-; (if (= (char-before (1- orgpoint)) ?,)
- (list column 0)
-; (list column 'ada-broken-indent)
-; )
- )))))
+ ;; We want all continuation lines to be indented the same
+ ;; (ada-broken-line from the opening parenthesis. However, in
+ ;; parameter list, each new parameter should be indented at the
+ ;; column as the opening parenthesis.
+
+ ;; A special case to handle nested boolean expressions, as in
+ ;; ((B
+ ;; and then C) -- indented by ada-broken-indent
+ ;; or else D) -- indenting this line.
+ ;; ??? This is really a hack, we should have a proper way to go to
+ ;; ??? the beginning of the statement
+
+ (if (= (char-before) ?\))
+ (backward-sexp))
+
+ (if (memq (char-before) '(?, ?\; ?\( ?\)))
+ (list column 0)
+ (list column 'ada-continuation-indent)
+ )))))
;;---------------------------
;; at end of buffer
(list (progn (back-to-indentation) (point)) 'ada-indent))
(save-excursion
(ada-goto-stmt-start)
- (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent))))
+ (if (looking-at "\\<package\\|procedure\\|function\\>")
+ (list (progn (back-to-indentation) (point)) 0)
+ (list (progn (back-to-indentation) (point)) 'ada-indent)))))
;;---------------------------
;; starting with r (return, renames)
;;
((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
(goto-char (car match-dat))
(unless (ada-in-open-paren-p)
- (if (and (looking-at
- "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")
- (save-excursion
- (ada-goto-previous-word)
- (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]")))
- (forward-word -1)
-
- (save-excursion
- (goto-char (cdr match-dat))
- (ada-goto-next-non-ws)
- (looking-at "(")
- ;; words that can go after an 'is'
- (unless (looking-at
- (eval-when-compile
- (concat "\\<"
- (regexp-opt '("separate" "access" "array"
- "abstract" "new") t)
- "\\>\\|(")))
- (setq found t))))
- ))
+ (cond
+
+ ((and (looking-at
+ "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")
+ (save-excursion
+ (ada-goto-previous-word)
+ (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]")))
+ (forward-word -1))
+
+ ((looking-at "is")
+ (setq found
+ (and (save-excursion (ada-goto-previous-word)
+ (ada-goto-previous-word)
+ (not (looking-at "subtype")))
+
+ (save-excursion (goto-char (cdr match-dat))
+ (ada-goto-next-non-ws)
+ ;; words that can go after an 'is'
+ (not (looking-at
+ (eval-when-compile
+ (concat "\\<"
+ (regexp-opt
+ '("separate" "access" "array"
+ "abstract" "new") t)
+ "\\>\\|("))))))))
+
+ (t
+ (setq found t))
+ )))
(if found
match-dat
(error (concat
"No matching 'is' or 'renames' for 'package' at"
" line "
- (number-to-string (count-lines (point-min)
- (1+ current)))))))
+ (number-to-string (count-lines 1 (1+ current)))))))
(unless (looking-at "renames")
(progn
(forward-word 1)
;; in the nesting loop below, so we just make sure we don't count it.
;; "declare" is a special case because we need to look after the "begin"
;; keyword
- (if (and (not first) (looking-at regex))
+ (if (looking-at "\\<if\\|loop\\|case\\>")
(forward-char 1))
;;
(save-excursion
(cond
+ ;; Go to the beginning of the current word, and check if we are
;; directly on 'begin'
((save-excursion
- (ada-goto-previous-word)
+ (skip-syntax-backward "w")
(looking-at "\\<begin\\>"))
(ada-goto-matching-end 1))
(setq decl-start (and (ada-goto-matching-decl-start t) (point)))
(and decl-start (looking-at "\\<package\\>")))
(ada-goto-matching-end 1))
+
+ ;; On a "declare" keyword
+ ((save-excursion
+ (skip-syntax-backward "w")
+ (looking-at "\\<declare\\>"))
+ (ada-goto-matching-end 0 t))
;; inside a 'begin' ... 'end' block
(decl-start
;; function for justifying the comments.
;; -------------------------------------------------------
-(defadvice comment-region (before ada-uncomment-anywhere)
+(defadvice comment-region (before ada-uncomment-anywhere disable)
(if (and arg
(listp arg) ;; a prefix with \C-u is of the form '(4), whereas
;; \C-u 2 sets arg to '2' (fixed by S.Leake)
(ad-activate 'comment-region)
(comment-region beg end (- (or arg 2)))
(ad-deactivate 'comment-region))
- (comment-region beg end (list (- (or arg 2))))))
+ (comment-region beg end (list (- (or arg 2))))
+ (ada-indent-region beg end)))
(defun ada-fill-comment-paragraph-justify ()
"Fills current comment paragraph and justifies each line as well."
(not (looking-at "[ \t]*--")))
(error "not inside comment"))
- (let* ((indent)
- (from)
- (to)
- (opos (point-marker))
+ (let* (indent from to
+ (opos (point-marker))
;; Sets this variable to nil, otherwise it prevents
;; fill-region-as-paragraph to work on Emacs <= 20.2
;; Find end of paragraph
(back-to-indentation)
- (while (and (not (eobp)) (looking-at "--[ \t]*[^ \t\n]"))
+ (while (and (not (eobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
(forward-line 1)
;; If we were at the last line in the buffer, create a dummy empty
;; Find beginning of paragraph
(back-to-indentation)
- (while (and (not (bobp)) (looking-at "--[ \t]*[^ \t\n]"))
+ (while (and (not (bobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
(forward-line -1)
(back-to-indentation))
- ;; We want one line to above the first one, unless we are at the beginning
+ ;; We want one line above the first one, unless we are at the beginning
;; of the buffer
(unless (bobp)
(forward-line 1))
(while (re-search-forward "--\n" to t)
(replace-match "\n"))
- ;; Remove the old prefixes (so that the number of spaces after -- is not
- ;; relevant), except on the first one since `fill-region-as-paragraph'
- ;; would not put it back on the first line.
- (goto-char (+ from 2))
- (while (re-search-forward "^-- *" to t)
- (replace-match " "))
-
(goto-char (1- to))
(setq to (point-marker))
(defun ada-which-function ()
"Returns the name of the function whose body the point is in.
This function works even in the case of nested subprograms, whereas the
-standard Emacs function which-function does not.
+standard Emacs function `which-function' does not.
Since the search can be long, the results are cached."
- (let ((line (count-lines (point-min) (point)))
+ (let ((line (count-lines 1 (point)))
(pos (point))
end-pos
func-name indent
(skip-chars-forward " \t\n(")
(condition-case nil
- (up-list)
+ (up-list 1)
(error nil))
(skip-chars-forward " \t\n")
projects / emacs.git / commitdiff