;;; 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, 03, 2004
;; 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.48 $
+;; Ada Core Technologies's version: Revision: 1.188
;; Keywords: languages ada
;; This file is part of GNU Emacs.
;;; Commentary:
;;; This mode is a major mode for editing Ada83 and Ada95 source code.
;;; This is a major rewrite of the file packaged with Emacs-20. The
-;;; ada-mode is composed of four lisp file, ada-mode.el, ada-xref.el,
+;;; ada-mode is composed of four lisp files, ada-mode.el, ada-xref.el,
;;; ada-prj.el and ada-stmt.el. Only this file (ada-mode.el) is
;;; completely independent from the GNU Ada compiler Gnat, distributed
;;; by Ada Core Technologies. All the other files rely heavily on
;;; `abbrev-mode': Provides the capability to define abbreviations, which
;;; are automatically expanded when you type them. See the Emacs manual.
+(eval-when-compile
+ (require 'ispell nil t)
+ (require 'find-file nil t)
+ (require 'align nil t)
+ (require 'which-func nil t)
+ (require 'compile nil t))
;; this function is needed at compile time
(eval-and-compile
(>= emacs-minor-version minor)))))))
-;; We create a constant for that, for efficiency only
-;; This should be evaluated both at compile time, only a runtime
-(eval-and-compile
- (defconst ada-xemacs (and (boundp 'running-xemacs)
- (symbol-value 'running-xemacs))
- "Return t if we are using XEmacs."))
-
-(unless ada-xemacs
- (require 'outline))
-
-(eval-and-compile
- (condition-case nil (require 'find-file) (error nil)))
-
;; This call should not be made in the release that is done for the
-;; official FSF Emacs, since it does nothing useful for the latest version
-(if (not (ada-check-emacs-version 21 1))
- (require 'ada-support))
+;; official Emacs, since it does nothing useful for the latest version
+;;(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.
-This hook is automatically executed after the ada-mode is
+This hook is automatically executed after the `ada-mode' is
fully loaded.
This is a good place to add Ada environment specific bindings.")
>>>>>>>>>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',
Value_1,
Value_2);"
:type 'boolean :group 'ada)
-
+
(defcustom ada-indent-is-separate t
"*Non-nil means indent 'is separate' or 'is abstract' if on a single line."
:type 'boolean :group 'ada)
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
:group 'ada)
(defcustom ada-search-directories
- '("." "$ADA_INCLUDE_PATH" "/usr/adainclude" "/usr/local/adainclude"
- "/opt/gnu/adainclude")
+ (append '(".")
+ (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
+ '("/usr/adainclude" "/usr/local/adainclude"
+ "/opt/gnu/adainclude"))
"*List of directories to search for Ada files.
-See the description for the `ff-search-directories' variable.
-Emacs will automatically add the paths defined in your project file, and if you
-are using the GNAT compiler the output of the gnatls command to find where the
-runtime really is."
+See the description for the `ff-search-directories' variable. This variable
+is the initial value of this variable, and is copied and modified in
+`ada-search-directories-internal'."
:type '(repeat (choice :tag "Directory"
(const :tag "default" nil)
(directory :format "%v")))
:group 'ada)
+(defvar ada-search-directories-internal ada-search-directories
+ "Internal version of `ada-search-directories'.
+Its value is the concatenation of the search path as read in the project file
+and the standard runtime location, and the value of the user-defined
+ada-search-directories.")
+
(defcustom ada-stmt-end-indent 0
"*Number of columns to indent the end of a statement on a separate line.
calling `region-end' and `region-beginning'.
Modify this variable if you want to restore the point to another position.")
-(defvar ada-contextual-menu
- (if ada-xemacs
- '("Ada"
- ["Goto Declaration/Body"
- (ada-call-from-contextual-menu 'ada-point-and-xref)
- :included (and (functionp 'ada-point-and-xref)
- ada-contextual-menu-on-identifier)]
- ["Goto Previous Reference"
- (ada-call-from-contextual-menu 'ada-xref-goto-previous-reference)
- :included (functionp 'ada-xref-goto-previous-reference)]
- ["List References" ada-find-references
- :included ada-contextual-menu-on-identifier]
- ["-" nil nil]
- ["Other File" ff-find-other-file]
- ["Goto Parent Unit" ada-goto-parent]
- )
-
- (let ((map (make-sparse-keymap "Ada")))
- ;; The identifier part
- (if (equal ada-which-compiler 'gnat)
- (progn
- (define-key-after map [Ref]
- '(menu-item "Goto Declaration/Body"
- (lambda()(interactive)
- (ada-call-from-contextual-menu
- 'ada-point-and-xref))
- :visible
- (and (functionp 'ada-point-and-xref)
- ada-contextual-menu-on-identifier))
- t)
- (define-key-after map [Prev]
- '(menu-item "Goto Previous Reference"
- (lambda()(interactive)
- (ada-call-from-contextual-menu
- 'ada-xref-goto-previous-reference))
- :visible
- (functionp 'ada-xref-goto-previous-reference))
- t)
- (define-key-after map [List]
- '(menu-item "List References"
- ada-find-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)
- (define-key-after map [Parent] '("Goto Parent Unit" . ada-goto-parent)t)
- map))
- "Defines the menu to use when the user presses the right mouse button.
+(easy-menu-define ada-contextual-menu nil
+ "Menu to use when the user presses the right mouse button.
The variable `ada-contextual-menu-on-identifier' will be set to t before
displaying the menu if point was on an identifier."
- )
+ '("Ada"
+ ["Goto Declaration/Body" ada-point-and-xref
+ :included ada-contextual-menu-on-identifier]
+ ["Goto Body" ada-point-and-xref-body
+ :included ada-contextual-menu-on-identifier]
+ ["Goto Previous Reference" 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]))
\f
;;------------------------------------------------------------------
(looking-at
"\\([-_.a-zA-Z0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?"))
(let ((line (match-string 2))
+ file
(error-pos (point-marker))
source)
(save-excursion
(save-restriction
(widen)
;; Use funcall so as to prevent byte-compiler warnings
- (set-buffer (funcall (symbol-function 'compilation-find-file)
- (point-marker) (match-string 1)
- "./"))
+ ;; `ada-find-file' is not defined if ada-xref wasn't loaded. But
+ ;; if we can find it, we should use it instead of
+ ;; `compilation-find-file', since the latter doesn't know anything
+ ;; about source path.
+
+ (if (functionp 'ada-find-file)
+ (setq file (funcall (symbol-function 'ada-find-file)
+ (match-string 1)))
+ (setq file (funcall (symbol-function 'compilation-find-file)
+ (point-marker) (match-string 1)
+ "./")))
+ (set-buffer file)
+
(if (stringp line)
(goto-line (string-to-number line)))
(setq source (point-marker))))
;; See the comment above on grammar related function for the special
;; setup for '#'.
- (if ada-xemacs
+ (if (featurep 'xemacs)
(modify-syntax-entry ?# "<" ada-mode-syntax-table)
(modify-syntax-entry ?# "$" ada-mode-syntax-table))
;; Support of special characters in XEmacs (see the comments at the beginning
;; of the section on Grammar related functions).
-(if ada-xemacs
+(if (featurep 'xemacs)
(defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants)
"Handles special character constants and gnatprep statements."
(let (change)
(beginning-of-line)
(if (looking-at "^[ \t]*#")
(add-text-properties (match-beginning 0) (match-end 0)
- '(syntax-table (11 . 10))))
- ))))
+ '(syntax-table (11 . 10))))))))
;;------------------------------------------------------------------
;; Testing the grammatical context
"Returns t if inside a comment."
(nth 4 (or parse-result
(parse-partial-sexp
- (save-excursion (beginning-of-line) (point)) (point)))))
+ (line-beginning-position) (point)))))
(defsubst ada-in-string-p (&optional parse-result)
"Returns t if point is inside a string.
If parse-result is non-nil, use is instead of calling parse-partial-sexp."
(nth 3 (or parse-result
(parse-partial-sexp
- (save-excursion (beginning-of-line) (point)) (point)))))
+ (line-beginning-position) (point)))))
(defsubst ada-in-string-or-comment-p (&optional parse-result)
"Returns t if inside a comment or string."
(setq parse-result (or parse-result
(parse-partial-sexp
- (save-excursion (beginning-of-line) (point)) (point))))
+ (line-beginning-position) (point))))
(or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
(save-excursion (skip-syntax-forward "w")
(not (ada-after-keyword-p)))
))
- (let (choice)
- (if ada-xemacs
- (setq choice (funcall (symbol-function 'popup-menu)
- ada-contextual-menu))
- (setq choice (x-popup-menu position ada-contextual-menu)))
- (if choice
- (funcall (lookup-key ada-contextual-menu (vector (car choice))))))
+ (if (fboundp 'popup-menu)
+ (funcall (symbol-function 'popup-menu) ada-contextual-menu)
+ (let (choice)
+ (setq choice (x-popup-menu position ada-contextual-menu))
+ (if choice
+ (funcall (lookup-key ada-contextual-menu (vector (car choice)))))))
+
(set-buffer (cadr ada-contextual-menu-last-point))
(goto-char (car ada-contextual-menu-last-point))
))
;; Support for speedbar (Specifies that we want to see these files in
;; speedbar)
- (condition-case nil
+ (if (fboundp 'speedbar-add-supported-extension)
(progn
- (require 'speedbar)
(funcall (symbol-function 'speedbar-add-supported-extension)
spec)
(funcall (symbol-function 'speedbar-add-supported-extension)
;;;###autoload
(defun ada-mode ()
"Ada mode is the major mode for editing Ada code.
-This version was built on $Date: 2001/12/26 14:40:09 $.
Bindings are as follows: (Note: 'LFD' is control-j.)
\\{ada-mode-map}
;; Emacs 20.3 defines a comment-padding to insert spaces between
;; the comment and the text. We do not want any, this is already
;; included in comment-start
- (unless ada-xemacs
+ (unless (featurep 'xemacs)
(progn
(if (ada-check-emacs-version 20 3)
(progn
;; We need to set some properties for XEmacs, and define some variables
;; for Emacs
- (if ada-xemacs
+ (if (featurep 'xemacs)
;; XEmacs
(put 'ada-mode 'font-lock-defaults
'(ada-font-lock-keywords
(set (make-local-variable 'ff-other-file-alist)
'ada-other-file-alist)
(set (make-local-variable 'ff-search-directories)
- 'ada-search-directories)
- (setq ff-post-load-hooks 'ada-set-point-accordingly
- ff-file-created-hooks 'ada-make-body)
- (add-hook 'ff-pre-load-hooks 'ada-which-function-are-we-in)
+ 'ada-search-directories-internal)
+ (setq ff-post-load-hook 'ada-set-point-accordingly
+ ff-file-created-hook 'ada-make-body)
+ (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in)
;; Some special constructs for find-file.el
;; We do not need to add the construction for 'with', which is in the
"\\(body[ \t]+\\)?"
"\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
(lambda ()
- (set 'fname (ff-get-file
- ada-search-directories
- (ada-make-filename-from-adaname
- (match-string 3))
- ada-spec-suffixes)))))
+ (if (fboundp 'ff-get-file)
+ (if (boundp 'fname)
+ (set 'fname (ff-get-file
+ ada-search-directories-internal
+ (ada-make-filename-from-adaname
+ (match-string 3))
+ ada-spec-suffixes)))))))
;; Another special construct for find-file.el : when in a separate clause,
;; go to the correct package.
(add-to-list 'ff-special-constructs
(cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
(lambda ()
- (set 'fname (ff-get-file
- ada-search-directories
- (ada-make-filename-from-adaname
- (match-string 1))
- ada-spec-suffixes)))))
+ (if (fboundp 'ff-get-file)
+ (if (boundp 'fname)
+ (setq fname (ff-get-file
+ ada-search-directories-internal
+ (ada-make-filename-from-adaname
+ (match-string 1))
+ ada-spec-suffixes)))))))
+
;; Another special construct, that redefines the one in find-file.el. The
;; old one can handle only one possible type of extension for Ada files
;; remove from the list the standard "with..." that is put by find-file.el,
(assoc "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" ff-special-constructs))
(new-cdr
(lambda ()
- (set 'fname (ff-get-file
- ada-search-directories
- (ada-make-filename-from-adaname
- (match-string 1))
- ada-spec-suffixes)))))
+ (if (fboundp 'ff-get-file)
+ (if (boundp 'fname)
+ (set 'fname (ff-get-file
+ ada-search-directories-internal
+ (ada-make-filename-from-adaname
+ (match-string 1))
+ ada-spec-suffixes)))))))
(if old-construct
(setcdr old-construct new-cdr)
(add-to-list 'ff-special-constructs
(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-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.
+
+ (make-local-variable 'which-func-functions)
+ (setq which-func-functions '(ada-which-function))
+
;; 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))))))
(if ada-fill-comment-prefix
(set 'comment-start ada-fill-comment-prefix)
(set 'comment-start "-- "))
-
+
;; Run this after the hook to give the users a chance to activate
;; font-lock-mode
- (unless ada-xemacs
+ (unless (featurep 'xemacs)
(progn
(ada-initialize-properties)
- (make-local-hook 'font-lock-mode-hook)
(add-hook 'font-lock-mode-hook 'ada-deactivate-properties nil t)))
;; the following has to be done after running the ada-mode-hook
;; transient-mark-mode and mark-active are not defined in XEmacs
(defun ada-region-selected ()
"t if a region has been selected by the user and is still active."
- (or (and ada-xemacs (funcall (symbol-function 'region-active-p)))
- (and (not ada-xemacs)
+ (or (and (featurep 'xemacs) (funcall (symbol-function 'region-active-p)))
+ (and (not (featurep 'xemacs))
(symbol-value 'transient-mark-mode)
(symbol-value 'mark-active))))
(defun ada-save-exceptions-to-file (file-name)
"Save the exception lists `ada-case-exception' and
`ada-case-exception-substring' to the file FILE-NAME."
-
+
;; Save the list in the file
(find-file (expand-file-name file-name))
(erase-buffer)
(save-buffer)
(kill-buffer nil)
)
-
+
(defun ada-create-case-exception (&optional word)
"Defines WORD as an exception for the casing system.
If WORD is not given, then the current word in the buffer is used instead.
(save-excursion
(forward-word -1)
-
+
(unwind-protect
(progn
(modify-syntax-entry ?_ "." (syntax-table))
-
+
(while substrings
(setq re (concat "\\b" (regexp-quote (caar substrings)) "\\b"))
-
+
(save-excursion
(while (re-search-forward re max t)
- (replace-match (caar substrings))))
+ (replace-match (caar substrings) t)))
(setq substrings (cdr substrings))
)
)
(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)))
;; This need to be done here so that the advice is not always
;; activated (this might interact badly with other modes)
- (if ada-xemacs
+ (if (featurep 'xemacs)
(ad-activate 'parse-partial-sexp t))
(save-excursion
;; restore syntax-table
(set-syntax-table previous-syntax-table)
- (if ada-xemacs
+ (if (featurep 'xemacs)
(ad-deactivate 'parse-partial-sexp))
)
(goto-char column)
(skip-chars-backward " \t")
(list (1- (point)) 0))
-
+
(if (and (skip-chars-backward " \t")
(= (char-before) ?\n)
(not (forward-comment -10000))
;; ??? 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
(beginning-of-line)
(if (looking-at ada-named-block-re)
(setq label (- ada-label-indent))))))))
-
+
;; found 'record' =>
;; if the keyword is found at the beginning of a line (or just
;; after limited, we indent on it, otherwise we indent on the
(list (progn (back-to-indentation) (point)) 0))))
;; elsif
-
+
((looking-at "elsif\\>")
(save-excursion
(ada-goto-matching-start 1 nil t)
;;---------------------------
;; starting with w (when)
;;---------------------------
-
+
((and (= (downcase (char-after)) ?w)
(looking-at "when\\>"))
(save-excursion
;;---------------------------
;; starting with l (loop)
;;---------------------------
-
+
((and (= (downcase (char-after)) ?l)
(looking-at "loop\\>"))
(setq pos (point))
;;----------------------------
;; starting with l (limited) or r (record)
;;----------------------------
-
+
((or (and (= (downcase (char-after)) ?l)
(looking-at "limited\\>"))
(and (= (downcase (char-after)) ?r)
(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)
((and (= (downcase (char-after)) ?r)
(looking-at "re\\(turn\\|names\\)\\>"))
-
+
(save-excursion
(let ((var 'ada-indent-return))
;; If looking at a renames, skip the 'return' statement too
(= (downcase (char-after (car pos))) ?r))
(goto-char (car pos)))
(set 'var 'ada-indent-renames)))
-
+
(forward-comment -1000)
(if (= (char-before) ?\))
(forward-sexp -1)
(forward-word -1))
-
+
;; If there is a parameter list, and we have a function declaration
;; or a access to subprogram declaration
(let ((num-back 1))
(backward-word 1)
(set 'num-back 2)
(looking-at "\\(function\\|procedure\\)\\>")))))
-
+
;; The indentation depends of the value of ada-indent-return
(if (<= (eval var) 0)
(list (point) (list '- var))
(list (progn (backward-word num-back) (point))
var))
-
+
;; Else there is no parameter list, but we have a function
;; Only do something special if the user want to indent
;; relative to the "function" keyword
(save-excursion (forward-word -1)
(looking-at "function\\>")))
(list (progn (forward-word -1) (point)) var)
-
+
;; Else...
(ada-indent-on-previous-lines nil orgpoint orgpoint)))))))
-
+
;;--------------------------------
;; starting with 'o' or 'p'
;; 'or' as statement-start
;;
((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
"record" nil orgpoint nil 'word-search-forward))
t)))
(if match-cons
- (goto-char (car match-cons)))
- (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
+ (progn
+ (goto-char (car match-cons))
+ (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
+ (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
+ )
+
;;
;; for..loop
;;
(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)
+ (cond
- (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))))
- ))
+ ((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
;; "begin" we encounter.
(first (not recursive))
(count-generic nil)
- (stop-at-when nil)
+ (stop-at-when nil)
)
;; Ignore "when" most of the time, except if we are looking at the
(skip-chars-backward "a-zA-Z0-9_.'")
(ada-goto-previous-word)
(and
- (looking-at "\\<\\(sub\\)?type\\>")
+ (looking-at "\\<\\(sub\\)?type\\|case\\>")
(save-match-data
(ada-goto-previous-word)
(not (looking-at "\\<protected\\>"))))
(progn
(if stop-at-when
(setq nest-count (1- nest-count)))
- (setq first nil)))))
+ ))))
;;
((looking-at "begin")
(setq first nil))
;; it ends a block => increase nest depth
(setq nest-count (1+ nest-count)
pos (point))
-
+
;; it starts a block => decrease nest depth
(setq nest-count (1- nest-count))))
(goto-char pos))
(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)
(back-to-indentation)
(looking-at "\\<then\\>")))
(goto-char (match-beginning 0)))
-
+
;;
;; found 'do' => skip back to 'accept'
;;
'word-search-backward)
(error "missing 'accept' in front of 'do'"))))
(point))
-
+
(if noerror
nil
(error "no matching start"))))))
"if" "task" "package" "record" "do"
"procedure" "function") t)
"\\>")))
- found
+ found
+ pos
;; First is used for subprograms: they are generally handled
;; recursively, but of course we do not want to do that the
;; 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\\|begin\\>")
(forward-char 1))
;;
;; handling.
;; Nothing should be done if we have only the specs or a
;; generic instantion.
-
+
((and (looking-at "\\<procedure\\|function\\>"))
(if first
(forward-word 1)
+
+ (setq pos (point))
(ada-search-ignore-string-comment "is\\|;")
- (ada-goto-next-non-ws)
- (unless (looking-at "\\<new\\>")
- (ada-goto-matching-end 0 t))))
-
+ (if (= (char-before) ?s)
+ (progn
+ (ada-goto-next-non-ws)
+ (unless (looking-at "\\<new\\>")
+ (progn
+ (goto-char pos)
+ (ada-goto-matching-end 0 t)))))))
+
;; found block end => decrease nest depth
((looking-at "\\<end\\>")
(setq nest-count (1- nest-count)
(ada-goto-next-non-ws)
(looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))
(forward-word 1)))
-
+
;; found package start => check if it really starts a block, and is not
;; in fact a generic instantiation for instance
((looking-at "\\<package\\>")
(goto-char (match-end 0))
(setq nest-count (1+ nest-count)
found (<= nest-count 0))))
-
+
;; all the other block starts
(t
- (setq nest-count (1+ nest-count)
- found (<= nest-count 0))
+ (if (not first)
+ (setq nest-count (1+ nest-count)))
+ (setq found (<= nest-count 0))
(forward-word 1))) ; end of 'cond'
(setq first nil))
;; If inside a string, skip it (and the following comments)
;;
((ada-in-string-p parse-result)
- (if ada-xemacs
+ (if (featurep 'xemacs)
(search-backward "\"" nil t)
(goto-char (nth 8 parse-result)))
(unless backward (forward-sexp 1)))
;; There is a special code for comments at the end of the file
;;
((ada-in-comment-p parse-result)
- (if ada-xemacs
+ (if (featurep 'xemacs)
(progn
(forward-line 1)
(beginning-of-line)
;; Value_1);
;; type B is ( -- comment
;; Value_2);
-
+
(if (or (not ada-indent-handle-comment-special)
(not (looking-at "[ \t]+--")))
(skip-chars-forward " \t"))
(replace-match "-- \\1")
(forward-line 1)
(beginning-of-line))
-
+
(goto-char (point-min))
(while (re-search-forward "\\>(" nil t)
(if (not (ada-in-string-or-comment-p))
(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))
-
+ (ada-goto-matching-end 1)
+ )
+
;; on first line of subprogram body
;; Do nothing for specs or generic instantion, since these are
;; handled as the general case (find the enclosing block)
))
(skip-syntax-backward "w")
(ada-goto-matching-end 0 t))
-
+
;; on first line of task declaration
((save-excursion
(and (ada-goto-stmt-start)
(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
(goto-char decl-start)
(ada-goto-matching-end 0 t))
-
+
;; (hopefully ;-) everything else
(t
(ada-goto-matching-end 1)))
(define-key ada-mode-map "\t" 'ada-tab)
(define-key ada-mode-map "\C-c\t" 'ada-justified-indent-current)
(define-key ada-mode-map "\C-c\C-l" 'ada-indent-region)
- (if ada-xemacs
+ (if (featurep 'xemacs)
(define-key ada-mode-map '(shift tab) 'ada-untab)
(define-key ada-mode-map [(shift tab)] 'ada-untab))
(define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist)
;; Use predefined function of Emacs19 for comments (RE)
(define-key ada-mode-map "\C-c;" 'comment-region)
(define-key ada-mode-map "\C-c:" 'ada-uncomment-region)
+
+ ;; The following keys are bound to functions defined in ada-xref.el or
+ ;; ada-prj,el., However, RMS rightly thinks that the code should be shared,
+ ;; and activated only if the right compiler is used
+ (if (featurep 'xemacs)
+ (progn
+ (define-key ada-mode-map '(shift button3) 'ada-point-and-xref)
+ (define-key ada-mode-map '(control tab) 'ada-complete-identifier))
+ (define-key ada-mode-map [C-tab] 'ada-complete-identifier)
+ (define-key ada-mode-map [S-mouse-3] 'ada-point-and-xref))
+
+ (define-key ada-mode-map "\C-co" '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-map "\C-cr" '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-map "\C-c\C-v" 'ada-check-current)
+ (define-key ada-mode-map "\C-cf" 'ada-find-file)
+
+ (define-key ada-mode-map "\C-cu" 'ada-prj-edit)
+
+ ;; The templates, defined in ada-stmt.el
+
+ (let ((map (make-sparse-keymap)))
+ (define-key map "h" 'ada-header)
+ (define-key map "\C-a" 'ada-array)
+ (define-key map "b" 'ada-exception-block)
+ (define-key map "d" 'ada-declare-block)
+ (define-key map "c" 'ada-case)
+ (define-key map "\C-e" 'ada-elsif)
+ (define-key map "e" 'ada-else)
+ (define-key map "\C-k" 'ada-package-spec)
+ (define-key map "k" 'ada-package-body)
+ (define-key map "\C-p" 'ada-procedure-spec)
+ (define-key map "p" 'ada-subprogram-body)
+ (define-key map "\C-f" 'ada-function-spec)
+ (define-key map "f" 'ada-for-loop)
+ (define-key map "i" 'ada-if)
+ (define-key map "l" 'ada-loop)
+ (define-key map "\C-r" 'ada-record)
+ (define-key map "\C-s" 'ada-subtype)
+ (define-key map "S" 'ada-tabsize)
+ (define-key map "\C-t" 'ada-task-spec)
+ (define-key map "t" 'ada-task-body)
+ (define-key map "\C-y" 'ada-type)
+ (define-key map "\C-v" 'ada-private)
+ (define-key map "u" 'ada-use)
+ (define-key map "\C-u" 'ada-with)
+ (define-key map "\C-w" 'ada-when)
+ (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))
)
(defun ada-create-menu ()
- "Create the ada menu as shown in the menu bar.
-This function is designed to be extensible, so that each compiler-specific file
-can add its own items."
- ;; Note that the separators must have different length in the submenus
- (autoload 'easy-menu-define "easymenu")
-
- (let ((m '("Ada"
- ("Help" ["Ada Mode" (info "ada-mode") t])))
- (option '(["Auto Casing" (setq ada-auto-case (not ada-auto-case))
- :style toggle :selected ada-auto-case]
- ["Auto Indent After Return"
- (setq ada-indent-after-return (not ada-indent-after-return))
- :style toggle :selected ada-indent-after-return]))
- (goto '(["Next compilation error" next-error t]
- ["Previous Package" ada-previous-package t]
- ["Next Package" ada-next-package t]
- ["Previous Procedure" ada-previous-procedure t]
- ["Next Procedure" ada-next-procedure t]
- ["Goto Start Of Statement" ada-move-to-start t]
- ["Goto End Of Statement" ada-move-to-end t]
- ["-" nil nil]
- ["Other File" ff-find-other-file t]
- ["Other File Other Window" ada-ff-other-window t]))
- (edit '(["Indent Line" ada-indent-current-function t]
- ["Justify Current Indentation" ada-justified-indent-current t]
- ["Indent Lines in Selection" ada-indent-region t]
- ["Indent Lines in File" (ada-indent-region (point-min) (point-max)) t]
- ["Format Parameter List" ada-format-paramlist t]
- ["-" nil nil]
- ["Comment Selection" comment-region t]
- ["Uncomment Selection" ada-uncomment-region t]
- ["--" nil nil]
- ["Fill Comment Paragraph" fill-paragraph t]
- ["Fill Comment Paragraph Justify" ada-fill-comment-paragraph-justify t]
- ["Fill Comment Paragraph Postfix" ada-fill-comment-paragraph-postfix t]
- ["---" nil nil]
- ["Adjust Case Selection" ada-adjust-case-region t]
- ["Adjust Case in File" ada-adjust-case-buffer t]
- ["Create Case Exception" ada-create-case-exception t]
- ["Create Case Exception Substring"
- ada-create-case-exception-substring t]
- ["Reload Case Exceptions" ada-case-read-exceptions t]
- ["----" nil nil]
- ["Make body for subprogram" ada-make-subprogram-body t]))
-
- )
-
- ;; Option menu present only if in Ada mode
- (setq m (append m (list (append '("Options"
- :included '(eq major-mode 'ada-mode))
- option))))
-
- ;; Customize menu always present
- (when (fboundp 'customize-group)
- (setq m (append m '(["Customize" (customize-group 'ada)]))))
-
- ;; Goto and Edit menus present only if in Ada mode
- (setq m (append m (list (append '("Goto"
- :included (eq major-mode 'ada-mode))
- goto)
- (append '("Edit"
- :included (eq major-mode 'ada-mode))
- edit))))
+ "Create the ada menu as shown in the menu bar."
+ (let ((m '("Ada"
+ ("Help"
+ ["Ada Mode" (info "ada-mode") t]
+ ["GNAT User's Guide" (info "gnat_ugn")
+ (eq ada-which-compiler 'gnat)]
+ ["GNAT Reference Manual" (info "gnat_rm")
+ (eq ada-which-compiler 'gnat)]
+ ["Gcc Documentation" (info "gcc")
+ (eq ada-which-compiler 'gnat)]
+ ["Gdb Documentation" (info "gdb")
+ (eq ada-which-compiler 'gnat)]
+ ["Ada95 Reference Manual" (info "arm95")
+ (eq ada-which-compiler 'gnat)])
+ ("Options" :included (eq major-mode 'ada-mode)
+ ["Auto Casing" (setq ada-auto-case (not ada-auto-case))
+ :style toggle :selected ada-auto-case]
+ ["Auto Indent After Return"
+ (setq ada-indent-after-return (not ada-indent-after-return))
+ :style toggle :selected ada-indent-after-return]
+ ["Automatically Recompile For Cross-references"
+ (setq ada-xref-create-ali (not ada-xref-create-ali))
+ :style toggle :selected ada-xref-create-ali
+ :included (eq ada-which-compiler 'gnat)]
+ ["Confirm Commands"
+ (setq ada-xref-confirm-compile (not ada-xref-confirm-compile))
+ :style toggle :selected ada-xref-confirm-compile
+ :included (eq ada-which-compiler 'gnat)]
+ ["Show Cross-references In Other Buffer"
+ (setq ada-xref-other-buffer (not ada-xref-other-buffer))
+ :style toggle :selected ada-xref-other-buffer
+ :included (eq ada-which-compiler 'gnat)]
+ ["Tight Integration With GNU Visual Debugger"
+ (setq ada-tight-gvd-integration (not ada-tight-gvd-integration))
+ :style toggle :selected ada-tight-gvd-integration
+ :included (string-match "gvd" ada-prj-default-debugger)])
+ ["Customize" (customize-group 'ada)
+ :included (fboundp 'customize-group)]
+ ["Check file" ada-check-current (eq ada-which-compiler 'gnat)]
+ ["Compile file" ada-compile-current (eq ada-which-compiler 'gnat)]
+ ["Build" ada-compile-application
+ (eq ada-which-compiler 'gnat)]
+ ["Run" ada-run-application t]
+ ["Debug" ada-gdb-application (eq ada-which-compiler 'gnat)]
+ ["------" nil nil]
+ ("Project"
+ :included (eq ada-which-compiler 'gnat)
+ ["Load..." ada-set-default-project-file t]
+ ["New..." ada-prj-new t]
+ ["Edit..." ada-prj-edit t])
+ ("Goto" :included (eq major-mode 'ada-mode)
+ ["Goto Declaration/Body" ada-goto-declaration
+ (eq ada-which-compiler 'gnat)]
+ ["Goto Body" ada-goto-body
+ (eq ada-which-compiler 'gnat)]
+ ["Goto Declaration Other Frame"
+ ada-goto-declaration-other-frame
+ (eq ada-which-compiler 'gnat)]
+ ["Goto Previous Reference" ada-xref-goto-previous-reference
+ (eq ada-which-compiler 'gnat)]
+ ["List Local References" ada-find-local-references
+ (eq ada-which-compiler 'gnat)]
+ ["List References" ada-find-references
+ (eq ada-which-compiler 'gnat)]
+ ["Goto Reference To Any Entity" ada-find-any-references
+ (eq ada-which-compiler 'gnat)]
+ ["Goto Parent Unit" ada-goto-parent
+ (eq ada-which-compiler 'gnat)]
+ ["--" nil nil]
+ ["Next compilation error" next-error t]
+ ["Previous Package" ada-previous-package t]
+ ["Next Package" ada-next-package t]
+ ["Previous Procedure" ada-previous-procedure t]
+ ["Next Procedure" ada-next-procedure t]
+ ["Goto Start Of Statement" ada-move-to-start t]
+ ["Goto End Of Statement" ada-move-to-end t]
+ ["-" nil nil]
+ ["Other File" ff-find-other-file t]
+ ["Other File Other Window" ada-ff-other-window t])
+ ("Edit" :included (eq major-mode 'ada-mode)
+ ["Search File On Source Path" ada-find-file t]
+ ["------" nil nil]
+ ["Complete Identifier" ada-complete-identifier t]
+ ["-----" nil nil]
+ ["Indent Line" ada-indent-current-function t]
+ ["Justify Current Indentation" ada-justified-indent-current t]
+ ["Indent Lines in Selection" ada-indent-region t]
+ ["Indent Lines in File"
+ (ada-indent-region (point-min) (point-max)) t]
+ ["Format Parameter List" ada-format-paramlist t]
+ ["-" nil nil]
+ ["Comment Selection" comment-region t]
+ ["Uncomment Selection" ada-uncomment-region t]
+ ["--" nil nil]
+ ["Fill Comment Paragraph" fill-paragraph t]
+ ["Fill Comment Paragraph Justify"
+ ada-fill-comment-paragraph-justify t]
+ ["Fill Comment Paragraph Postfix"
+ ada-fill-comment-paragraph-postfix t]
+ ["---" nil nil]
+ ["Adjust Case Selection" ada-adjust-case-region t]
+ ["Adjust Case in File" ada-adjust-case-buffer t]
+ ["Create Case Exception" ada-create-case-exception t]
+ ["Create Case Exception Substring"
+ ada-create-case-exception-substring t]
+ ["Reload Case Exceptions" ada-case-read-exceptions t]
+ ["----" nil nil]
+ ["Make body for subprogram" ada-make-subprogram-body t]
+ ["-----" nil nil]
+ ["Narrow to subprogram" ada-narrow-to-defun t])
+ ("Templates"
+ :included (eq major-mode 'ada-mode)
+ ["Header" ada-header t]
+ ["-" nil nil]
+ ["Package Body" ada-package-body t]
+ ["Package Spec" ada-package-spec t]
+ ["Function Spec" ada-function-spec t]
+ ["Procedure Spec" ada-procedure-spec t]
+ ["Proc/func Body" ada-subprogram-body t]
+ ["Task Body" ada-task-body t]
+ ["Task Spec" ada-task-spec t]
+ ["Declare Block" ada-declare-block t]
+ ["Exception Block" ada-exception-block t]
+ ["--" nil nil]
+ ["Entry" ada-entry t]
+ ["Entry family" ada-entry-family t]
+ ["Select" ada-select t]
+ ["Accept" ada-accept t]
+ ["Or accept" ada-or-accep t]
+ ["Or delay" ada-or-delay t]
+ ["Or terminate" ada-or-terminate t]
+ ["---" nil nil]
+ ["Type" ada-type t]
+ ["Private" ada-private t]
+ ["Subtype" ada-subtype t]
+ ["Record" ada-record t]
+ ["Array" ada-array t]
+ ["----" nil nil]
+ ["If" ada-if t]
+ ["Else" ada-else t]
+ ["Elsif" ada-elsif t]
+ ["Case" ada-case t]
+ ["-----" nil nil]
+ ["While Loop" ada-while-loop t]
+ ["For Loop" ada-for-loop t]
+ ["Loop" ada-loop t]
+ ["------" nil nil]
+ ["Exception" ada-exception t]
+ ["Exit" ada-exit t]
+ ["When" ada-when t])
+ )))
(easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode" m)
- (easy-menu-add ada-mode-menu ada-mode-map)
- (when ada-xemacs
- ;; This looks bogus to me! -stef
- (define-key ada-mode-map [menu-bar] ada-mode-menu)
- (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu)))))
+ (if (featurep 'xemacs)
+ (progn
+ (define-key ada-mode-map [menu-bar] ada-mode-menu)
+ (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
\f
;; -------------------------------------------------------
;; 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)
;; This advice is not needed anymore with Emacs21. However, for older
;; versions, as well as for XEmacs, we still need to enable it.
- (if (or (<= emacs-major-version 20) (boundp 'running-xemacs))
+ (if (or (<= emacs-major-version 20) (featurep 'xemacs))
(progn
(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))
;; In Emacs <= 20.2 and XEmacs <=20.4, there is a bug, and a newline is
;; inserted at the end. Delete it
- (if (or ada-xemacs
+ (if (or (featurep 'xemacs)
(<= emacs-major-version 19)
(and (= emacs-major-version 20)
(<= emacs-minor-version 2)))
;; If we are using project file, search for the other file in all
;; the possible src directories.
-
- (if (functionp 'ada-find-src-file-in-dir)
+
+ (if (fboundp 'ada-find-src-file-in-dir)
(let ((other
(ada-find-src-file-in-dir
(file-name-nondirectory (concat name (car suffixes))))))
(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
;; Are we looking at "function Foo\n (paramlist)"
(skip-chars-forward " \t\n(")
-
+
(condition-case nil
- (up-list)
+ (up-list 1)
(error nil))
(skip-chars-forward " \t\n")
(forward-word 1)
(skip-chars-forward " \t\n")
(skip-chars-forward "a-zA-Z0-9_'")))
-
+
;; Can't simply do forward-word, in case the "is" is not on the
;; same line as the closing parenthesis
(skip-chars-forward "is \t\n")
(setq suffixes (cdr suffixes))))
;; If find-file.el was available, use its functions
- (if (functionp 'ff-get-file)
- (ff-get-file-name ada-search-directories
+ (if (fboundp 'ff-get-file-name)
+ (ff-get-file-name ada-search-directories-internal
(ada-make-filename-from-adaname
(file-name-nondirectory
(file-name-sans-extension spec-name)))
"null" "or" "others" "private" "protected" "raise"
"range" "record" "rem" "renames" "requeue" "return" "reverse"
"select" "separate" "tagged" "task" "terminate" "then" "until"
- "when" "while" "xor") t)
+ "when" "while" "with" "xor") t)
"\\>")
;;
;; Anything following end and not already fontified is a body name.
(list (concat "\\<\\(goto\\|raise\\|use\\|with\\)"
"[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W")
'(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
+
;;
;; Goto tags.
'("<<\\(\\sw+\\)>>" 1 font-lock-reference-face)
;; Ada unnamed numerical constants
(list "\\W\\([-+]?[0-9._]+\\)\\>" '(1 font-lock-constant-face))
-
+
))
"Default expressions to highlight in Ada mode.")
(back-to-indentation)
(current-column))))
+;; ---------------------------------------------------------
+;; Support for narrow-to-region
+;; ---------------------------------------------------------
+
+(defun ada-narrow-to-defun (&optional arg)
+ "make text outside current subprogram invisible.
+The subprogram visible is the one that contains or follow point.
+Optional ARG is ignored.
+Use `M-x widen' to go back to the full visibility for the buffer"
+
+ (interactive)
+ (save-excursion
+ (let (end)
+ (widen)
+ (forward-line 1)
+ (ada-previous-procedure)
+
+ (save-excursion
+ (beginning-of-line)
+ (setq end (point)))
+
+ (ada-move-to-end)
+ (end-of-line)
+ (narrow-to-region end (point))
+ (message
+ "Use M-x widen to get back to full visibility in the buffer"))))
+
;; ---------------------------------------------------------
;; Automatic generation of code
;; The Ada-mode has a set of function to automatically generate a subprogram
(setq body-file (ada-get-body-name))
(if body-file
(find-file body-file)
- (error "No body found for the package. Create it first"))
+ (error "No body found for the package. Create it first."))
(save-restriction
(widen)
;; Read the special cases for exceptions
(ada-case-read-exceptions)
-;; include the other ada-mode files
+;; Setup auto-loading of the other ada-mode files.
(if (equal ada-which-compiler 'gnat)
(progn
- ;; The order here is important: ada-xref defines the Project
- ;; submenu, and ada-prj adds to it.
- (require 'ada-xref)
- (condition-case nil (require 'ada-prj) (error nil))
+ (autoload 'ada-change-prj "ada-xref" nil t)
+ (autoload 'ada-check-current "ada-xref" nil t)
+ (autoload 'ada-compile-application "ada-xref" nil t)
+ (autoload 'ada-compile-current "ada-xref" nil t)
+ (autoload 'ada-complete-identifier "ada-xref" nil t)
+ (autoload 'ada-find-file "ada-xref" nil t)
+ (autoload 'ada-find-any-references "ada-xref" nil t)
+ (autoload 'ada-find-src-file-in-dir "ada-xref" nil t)
+ (autoload 'ada-find-local-references "ada-xref" nil t)
+ (autoload 'ada-find-references "ada-xref" nil t)
+ (autoload 'ada-gdb-application "ada-xref" nil t)
+ (autoload 'ada-goto-declaration "ada-xref" nil t)
+ (autoload 'ada-goto-declaration-other-frame "ada-xref" nil t)
+ (autoload 'ada-goto-parent "ada-xref" nil t)
+ (autoload 'ada-make-body-gnatstub "ada-xref" nil 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-customize "ada-prj" nil t)
+ (autoload 'ada-prj-edit "ada-prj" nil t)
+ (autoload 'ada-prj-new "ada-prj" nil t)
+ (autoload 'ada-prj-save "ada-prj" nil t)
))
-(condition-case nil (require 'ada-stmt) (error nil))
+
+(autoload 'ada-array "ada-stmt" nil t)
+(autoload 'ada-case "ada-stmt" nil t)
+(autoload 'ada-declare-block "ada-stmt" nil t)
+(autoload 'ada-else "ada-stmt" nil t)
+(autoload 'ada-elsif "ada-stmt" nil t)
+(autoload 'ada-exception "ada-stmt" nil t)
+(autoload 'ada-exception-block "ada-stmt" nil t)
+(autoload 'ada-exit "ada-stmt" nil t)
+(autoload 'ada-for-loop "ada-stmt" nil t)
+(autoload 'ada-function-spec "ada-stmt" nil t)
+(autoload 'ada-header "ada-stmt" nil t)
+(autoload 'ada-if "ada-stmt" nil t)
+(autoload 'ada-loop "ada-stmt" nil t)
+(autoload 'ada-package-body "ada-stmt" nil t)
+(autoload 'ada-package-spec "ada-stmt" nil t)
+(autoload 'ada-private "ada-stmt" nil t)
+(autoload 'ada-procedure-spec "ada-stmt" nil t)
+(autoload 'ada-record "ada-stmt" nil t)
+(autoload 'ada-subprogram-body "ada-stmt" nil t)
+(autoload 'ada-subtype "ada-stmt" nil t)
+(autoload 'ada-tabsize "ada-stmt" nil t)
+(autoload 'ada-task-body "ada-stmt" nil t)
+(autoload 'ada-task-spec "ada-stmt" nil t)
+(autoload 'ada-type "ada-stmt" nil t)
+(autoload 'ada-use "ada-stmt" nil t)
+(autoload 'ada-when "ada-stmt" nil t)
+(autoload 'ada-while-loop "ada-stmt" nil t)
+(autoload 'ada-with "ada-stmt" nil t)
;;; provide ourselves
(provide 'ada-mode)
+;;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270
;;; ada-mode.el ends here