;;; 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-prj.el and ada-stmt.el. Only this file (ada-mode.el) is
+;;; 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
+;;; by Ada Core Technologies. All the other files rely heavily on
;;; features provided only by Gnat.
;;;
;;; Note: this mode will not work with Emacs 19. If you are on a VMS
;;; `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
(defun ada-check-emacs-version (major minor &optional is-xemacs)
- "Returns t if Emacs's version is greater or equal to MAJOR.MINOR.
+ "Return t if Emacs's version is greater or equal to MAJOR.MINOR.
If IS-XEMACS is non-nil, check for XEmacs instead of Emacs."
(let ((xemacs-running (or (string-match "Lucid" emacs-version)
(string-match "XEmacs" emacs-version))))
(>= 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',
when you call `ada-create-case-exception'.
These files should contain one word per line, that gives the casing
-to be used for that word in Ada files. If the line starts with the
+to be used for that word in Ada files. If the line starts with the
character *, then the exception will be used for substrings that either
start at the beginning of a word or after a _ character, and end either
-at the end of the word or at a _ character. Each line can be terminated by
+at the end of the word or at a _ character. Each line can be terminated by
a comment."
:type '(repeat (file))
:group 'ada)
(defcustom ada-indent-comment-as-code t
"*Non-nil means indent comment lines as code.
-nil means do not auto-indent comments."
+A nil value means do not auto-indent comments."
:type 'boolean :group 'ada)
(defcustom ada-indent-handle-comment-special nil
- "*Non-nil if comment lines should be handled specially inside
-parenthesis.
+ "*Non-nil if comment lines should be handled specially inside parenthesis.
By default, if the line that contains the open parenthesis has some
text following it, then the following lines will be indented in the
-same column as this text. This will not be true if the first line is
+same column as this text. This will not be true if the first line is
a comment and `ada-indent-handle-comment-special' is t.
type A is
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)
(defcustom ada-indent-renames ada-broken-indent
"*Indentation for renames relative to the matching function statement.
-If ada-indent-return is null or negative, the indentation is done relative to
-the open parenthesis (if there is no parenthesis, ada-broken-indent is used).
+If `ada-indent-return' is null or negative, the indentation is done relative to
+the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
An example is:
function A (B : Integer)
(defcustom ada-indent-return 0
"*Indentation for 'return' relative to the matching 'function' statement.
-If ada-indent-return is null or negative, the indentation is done relative to
-the open parenthesis (if there is no parenthesis, ada-broken-indent is used).
+If `ada-indent-return' is null or negative, the indentation is done relative to
+the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
An example is:
function A (B : Integer)
(defcustom ada-fill-comment-postfix " --"
"*Text inserted at the end of each line when filling a comment paragraph.
-with `ada-fill-comment-paragraph-postfix'."
+Used by `ada-fill-comment-paragraph-postfix'."
:type 'string :group 'ada)
(defcustom ada-label-indent -4
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.
(defcustom ada-tab-policy 'indent-auto
"*Control the behavior of the TAB key.
Must be one of :
-`indent-rigidly' : always adds ada-indent blanks at the beginning of the line.
+`indent-rigidly' : always adds `ada-indent' blanks at the beginning of the line.
`indent-auto' : use indentation functions in this file.
`always-tab' : do indent-relative."
:type '(choice (const indent-auto)
"*Name of the compiler to use.
This will determine what features are made available through the ada-mode.
The possible choices are :
-`gnat': Use Ada Core Technologies' Gnat compiler. Add some cross-referencing
+`gnat': Use Ada Core Technologies' Gnat compiler. Add some cross-referencing
features
`generic': Use a generic compiler"
:type '(choice (const gnat)
(defvar ada-case-exception-substring '()
"Alist of substrings (entities) that have special casing.
The substrings are detected for word constituant when the word
-is not itself in ada-case-exception, and only for substrings that
+is not itself in `ada-case-exception', and only for substrings that
either are at the beginning or end of the word, or start after '_'.")
(defvar ada-lfd-binding nil
"Variable to save key binding of LFD when casing is activated.")
(defvar ada-other-file-alist nil
- "Variable used by find-file to find the name of the other package.
+ "Variable used by `find-file' to find the name of the other package.
See `ff-other-file-alist'.")
(defvar ada-align-list
"type\\|"
"when"
"\\)\\>\\)")
- "see the variable `align-region-separate' for more information.")
+ "See the variable `align-region-separate' for more information.")
;;; ---- Below are the regexp used in this package for parsing
'("end" "loop" "select" "begin" "case" "do"
"if" "task" "package" "record" "protected") t)
"\\>"))
- "Regexp used in ada-goto-matching-start.")
+ "Regexp used in `ada-goto-matching-start'.")
(defvar ada-matching-decl-start-re
(eval-when-compile
(regexp-opt
'("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
"\\>"))
- "Regexp used in ada-goto-matching-decl-start.")
+ "Regexp used in `ada-goto-matching-decl-start'.")
(defvar ada-loop-start-re
"\\<\\(for\\|while\\|loop\\)\\>"
"Position of point just before displaying the menu.
This is a list (point buffer).
Since `ada-popup-menu' moves the point where the user clicked, the region
-is modified. Therefore no command from the menu knows what the user selected
+is modified. Therefore no command from the menu knows what the user selected
before displaying the contextual menu.
To get the original region, restore the point to this position before
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
;;------------------------------------------------------------------
"^[ \t]*protected[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
'("*Packages*" "^[ \t]*package[ \t]+\\(\\(body[ \t]+\\)?\\(\\sw\\|[_.]\\)+\\)" 1))
"Imenu generic expression for Ada mode.
-See `imenu-generic-expression'. This variable will create several submenus for
+See `imenu-generic-expression'. This variable will create several submenus for
each type of entity that can be found in an Ada file.")
\f
)
(defun ada-compile-goto-error (pos)
- "Replaces `compile-goto-error' from compile.el.
-If POS is on a file and line location, go to this position. It adds to
-compile.el the capacity to go to a reference in an error message.
+ "Replace `compile-goto-error' from compile.el.
+If POS is on a file and line location, go to this position. It adds
+to compile.el the capacity to go to a reference in an error message.
For instance, on this line:
foo.adb:61:11: [...] in call to size declared at foo.ads:11
both file locations can be clicked on and jumped to."
(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
;;------------------------------------------------------------------
(defsubst ada-in-comment-p (&optional parse-result)
- "Returns t if inside a comment."
+ "Return 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."
+ "Return 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."
+ "Return 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)))
"Pops up a contextual menu, depending on where the user clicked.
POSITION is the location the mouse was clicked on.
Sets `ada-contextual-menu-last-point' to the current position before
-displaying the menu. When a function from the menu is called, the point is
-where the mouse button was clicked."
+displaying the menu. When a function from the menu is called, the
+point is where the mouse button was clicked."
(interactive "e")
;; declare this as a local variable, so that the function called
(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))
))
"Define SPEC and BODY as being valid extensions for Ada files.
Going from body to spec with `ff-find-other-file' used these
extensions.
-SPEC and BODY are two regular expressions that must match against the file
-name"
+SPEC and BODY are two regular expressions that must match against
+the file name."
(let* ((reg (concat (regexp-quote body) "$"))
(tmp (assoc reg ada-other-file-alist)))
(if tmp
;; 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}
Continue comment on next line '\\[indent-new-comment-line]'
If you use imenu.el:
- Display index-menu of functions & procedures '\\[imenu]'
+ Display index-menu of functions and procedures '\\[imenu]'
If you use find-file.el:
Switch to other file (Body <-> Spec) '\\[ff-find-other-file]'
(interactive)
(kill-all-local-variables)
- (set (make-local-variable 'require-final-newline) t)
+ (set (make-local-variable 'require-final-newline) mode-require-final-newline)
;; Set the paragraph delimiters so that one can select a whole block
;; simply with M-h
;; 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))))))
- (run-hooks 'ada-mode-hook)
+ (set (make-local-variable 'skeleton-further-elements)
+ '((< '(backward-delete-char-untabify
+ (min ada-indent (current-column))))))
+ (add-hook 'skeleton-end-hook 'ada-adjust-case-skeleton nil t)
+
+ (run-mode-hooks 'ada-mode-hook)
;; To be run after the hook, in case the user modified
;; ada-fill-comment-prefix
(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
(if ada-auto-case
(ada-activate-keys-for-case)))
+(defun ada-adjust-case-skeleton ()
+ "Adjust the case of the text inserted by a skeleton."
+ (save-excursion
+ (let ((aa-end (point)))
+ (ada-adjust-case-region
+ (progn (goto-char (symbol-value 'beg)) (forward-word -1) (point))
+ (goto-char aa-end)))))
;; 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)
+ "Return t if a region has been selected by the user and is still active."
+ (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.
+ "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 standard casing rules will no longer apply to this word."
(setq file-name (car ada-case-exception-file)))
(t
(error (concat "No exception file specified. "
- "See variable ada-case-exception-file."))))
+ "See variable ada-case-exception-file"))))
(set-syntax-table ada-mode-symbol-syntax-table)
(unless word
;; If the word is already in the list, even with a different casing
;; we simply want to replace it.
(if (and (not (equal ada-case-exception '()))
- (assoc-ignore-case word ada-case-exception))
- (setcar (assoc-ignore-case word ada-case-exception) word)
+ (assoc-string word ada-case-exception t))
+ (setcar (assoc-string word ada-case-exception t) word)
(add-to-list 'ada-case-exception (cons word t))
)
))
(defun ada-create-case-exception-substring (&optional word)
- "Defines the substring WORD as an exception for the casing system.
+ "Define the substring WORD as an exception for the casing system.
If WORD is not given, then the current word in the buffer is used instead,
or the selected region if any is active.
-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'.
When auto-casing a word, this substring will be special-cased, unless the
word itself has a special casing."
(interactive)
(car ada-case-exception-file))
(t
(error (concat "No exception file specified. "
- "See variable ada-case-exception-file."))))))
+ "See variable ada-case-exception-file"))))))
;; Find the substring to define as an exception. Order is: the parameter,
;; if any, or the selected region, or the word under the cursor
;; If the word is already in the list, even with a different casing
;; we simply want to replace it.
(if (and (not (equal ada-case-exception-substring '()))
- (assoc-ignore-case word ada-case-exception-substring))
- (setcar (assoc-ignore-case word ada-case-exception-substring) word)
+ (assoc-string word ada-case-exception-substring t))
+ (setcar (assoc-string word ada-case-exception-substring t) word)
(add-to-list 'ada-case-exception-substring (cons word t))
)
(if (char-equal (string-to-char word) ?*)
(progn
(setq word (substring word 1))
- (unless (assoc-ignore-case word ada-case-exception-substring)
+ (unless (assoc-string word ada-case-exception-substring t)
(add-to-list 'ada-case-exception-substring (cons word t))))
- (unless (assoc-ignore-case word ada-case-exception)
+ (unless (assoc-string word ada-case-exception t)
(add-to-list 'ada-case-exception (cons word t)))))
(forward-line 1))
(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))
)
)
(point)))
match)
;; If we have an exception, replace the word by the correct casing
- (if (setq match (assoc-ignore-case (buffer-substring start end)
- ada-case-exception))
+ (if (setq match (assoc-string (buffer-substring start end)
+ ada-case-exception t))
(progn
(delete-region start end)
(ada-adjust-case-substring))))))
(defun ada-after-keyword-p ()
- "Returns t if cursor is after a keyword that is not an attribute."
+ "Return t if cursor is after a keyword that is not an attribute."
(save-excursion
(forward-word -1)
(and (not (and (char-before)
(looking-at (concat ada-keywords "[^_]")))))
(defun ada-adjust-case (&optional force-identifier)
- "Adjust the case of the word before the just typed character.
+ "Adjust the case of the word before the character just typed.
If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier."
(if (not (bobp))
(progn
(defun ada-adjust-case-interactive (arg)
"Adjust the case of the previous word, and process the character just typed.
-ARG is the prefix the user entered with \C-u."
+ARG is the prefix the user entered with \\[universal-argument]."
(interactive "P")
(if ada-auto-case
))
(defun ada-activate-keys-for-case ()
- "Modifies the key bindings for all the keys that should readjust the casing."
+ "Modify the key bindings for all the keys that should readjust the casing."
(interactive)
;; Save original key-bindings to allow swapping ret/lfd
;; when casing is activated.
(delete-char 1)))))
(defun ada-no-auto-case (&optional arg)
- "Does nothing.
+ "Do nothing.
This function can be used for the auto-casing variables in the ada-mode, to
adapt to unusal auto-casing schemes. Since it does nothing, you can for
instance use it for `ada-case-identifier' if you don't want any special
(modify-syntax-entry ?_ "w")))
(defun ada-adjust-case-region (from to)
- "Adjusts the case of all words in the region between FROM and TO.
-Attention: This function might take very long for big regions !"
+ "Adjust the case of all words in the region between FROM and TO.
+Attention: This function might take very long for big regions!"
(interactive "*r")
(let ((begin nil)
(end nil)
(defun ada-adjust-case-buffer ()
"Adjusts the case of all words in the whole buffer.
-ATTENTION: This function might take very long for big buffers !"
+ATTENTION: This function might take very long for big buffers!"
(interactive "*")
(ada-adjust-case-region (point-min) (point-max)))
;;--------------------------------------------------------------
(defun ada-format-paramlist ()
- "Reformats the parameter list point is in."
+ "Reformat the parameter list point is in."
(interactive)
(let ((begin nil)
(end nil)
;; check if really inside parameter list
(or (ada-in-paramlist-p)
- (error "not in parameter list"))
+ (error "Not in parameter list"))
;; find start of current parameter-list
(ada-search-ignore-string-comment
(defun ada-scan-paramlist (begin end)
"Scan the parameter list found in between BEGIN and END.
-Returns the equivalent internal parameter list."
+Return the equivalent internal parameter list."
(let ((paramlist (list))
(param (list))
(notend t)
(reverse paramlist)))
(defun ada-insert-paramlist (paramlist)
- "Inserts a formatted PARAMLIST in the buffer."
+ "Insert a formatted PARAMLIST in the buffer."
(let ((i (length paramlist))
(parlen 0)
(typlen 0)
(message "indenting ... done")))
(defun ada-indent-newline-indent ()
- "Indents the current line, inserts a newline and then indents the new line."
+ "Indent the current line, insert a newline and then indent the new line."
(interactive "*")
(ada-indent-current)
(newline)
(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.
-This function is intended to be bound to the \C-m and \C-j keys."
+This function is intended to be bound to the C-m and C-j keys."
(interactive "*")
(if ada-indent-after-return (ada-indent-current))
(newline)
(ada-indent-current))
(defun ada-justified-indent-current ()
- "Indent the current line and explains how the calculation was done."
+ "Indent the current line and explain how the calculation was done."
(interactive)
(let ((cur-indent (ada-indent-current)))
(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)))
(kill-emacs 0))
(defsubst ada-goto-previous-word ()
- "Moves point to the beginning of the previous word of Ada code.
-Returns the new position of point or nil if not found."
+ "Move point to the beginning of the previous word of Ada code.
+Return the new position of point or nil if not found."
(ada-goto-next-word t))
(defun ada-indent-current ()
"Indent current line as Ada code.
-Returns the calculation that was done, including the reference point and the
+Return the calculation that was done, including the reference point and the
offset."
(interactive)
(let ((previous-syntax-table (syntax-table))
;; 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
))
(defun ada-get-indent-open-paren ()
- "Calculates the indentation when point is behind an unclosed parenthesis."
+ "Calculate the indentation when point is behind an unclosed parenthesis."
(list (ada-in-open-paren-p) 0))
(defun ada-get-indent-nochange ()
(list (point) 0)))
(defun ada-get-indent-paramlist ()
- "Calculates the indentation when point is inside a parameter list."
+ "Calculate the indentation when point is inside a parameter list."
(save-excursion
(ada-search-ignore-string-comment "[^ \t\n]" t nil t)
(cond
(list (point) 0)))))
(defun ada-get-indent-end (orgpoint)
- "Calculates the indentation when point is just before an end_statement.
+ "Calculate the indentation when point is just before an end statement.
ORGPOINT is the limit position used in the calculation."
(let ((defun-name nil)
(indent nil))
'ada-broken-indent))))
(defun ada-get-indent-case (orgpoint)
- "Calculates the indentation when point is just before a case statement.
+ "Calculate the indentation when point is just before a case statement.
ORGPOINT is the limit position used in the calculation."
(let ((match-cons nil)
(opos (point)))
(save-excursion
(goto-char (car match-cons))
(unless (ada-search-ignore-string-comment "when" t opos)
- (error "missing 'when' between 'case' and '=>'"))
+ (error "Missing 'when' between 'case' and '=>'"))
(list (save-excursion (back-to-indentation) (point)) 'ada-indent)))
;;
;; case..is..when
'ada-broken-indent)))))
(defun ada-get-indent-when (orgpoint)
- "Calculates the indentation when point is just before a when statement.
+ "Calculate the indentation when point is just before a when statement.
ORGPOINT is the limit position used in the calculation."
(let ((cur-indent (save-excursion (back-to-indentation) (point))))
(if (ada-search-ignore-string-comment "[ \t\n]*=>" nil orgpoint)
(list cur-indent 'ada-broken-indent))))
(defun ada-get-indent-if (orgpoint)
- "Calculates the indentation when point is just before an if statement.
+ "Calculate the indentation when point is just before an if statement.
ORGPOINT is the limit position used in the calculation."
(let ((cur-indent (save-excursion (back-to-indentation) (point)))
(match-cons nil))
(list cur-indent 'ada-broken-indent))))
(defun ada-get-indent-block-start (orgpoint)
- "Calculates the indentation when point is at the start of a block.
+ "Calculate the indentation when point is at the start of a block.
ORGPOINT is the limit position used in the calculation."
(let ((pos nil))
(cond
(list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))
(defun ada-get-indent-subprog (orgpoint)
- "Calculates the indentation when point is just before a subprogram.
+ "Calculate the indentation when point is just before a subprogram.
ORGPOINT is the limit position used in the calculation."
(let ((match-cons nil)
(cur-indent (save-excursion (back-to-indentation) (point)))
(list cur-indent 'ada-broken-indent)))))
(defun ada-get-indent-noindent (orgpoint)
- "Calculates the indentation when point is just before a 'noindent stmt'.
+ "Calculate the indentation when point is just before a 'noindent stmt'.
ORGPOINT is the limit position used in the calculation."
(let ((label 0))
(save-excursion
'ada-broken-indent)))))))
(defun ada-get-indent-label (orgpoint)
- "Calculates the indentation when before a label or variable declaration.
+ "Calculate the indentation when before a label or variable declaration.
ORGPOINT is the limit position used in the calculation."
(let ((match-cons nil)
(cur-indent (save-excursion (back-to-indentation) (point))))
(list cur-indent '(- ada-label-indent))))))
(defun ada-get-indent-loop (orgpoint)
- "Calculates the indentation when just before a loop or a for ... use.
+ "Calculate the indentation when just before a loop or a for ... use.
ORGPOINT is the limit position used in the calculation."
(let ((match-cons nil)
(pos (point))
"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
;;
'ada-broken-indent))))))
(defun ada-get-indent-type (orgpoint)
- "Calculates the indentation when before a type statement.
+ "Calculate the indentation when before a type statement.
ORGPOINT is the limit position used in the calculation."
(let ((match-dat nil))
(cond
;; -----------------------------------------------------------
(defun ada-goto-stmt-start ()
- "Moves point to the beginning of the statement that point is in or after.
-Returns the new position of point.
+ "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
open parenthesis."
(let ((match-dat nil)
(defun ada-search-prev-end-stmt ()
- "Moves point to previous end-statement.
-Returns a cons cell whose car is the beginning and whose cdr the end of the
-match."
+ "Move point to previous end statement.
+Return a cons cell whose car is the beginning and whose cdr
+is the end of the match."
(let ((match-dat nil)
(found nil))
(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
(defun ada-goto-next-non-ws (&optional limit)
- "Skips white spaces, newlines and comments to next non-ws character.
+ "Skip white spaces, newlines and comments to next non-ws character.
Stop the search at LIMIT.
Do not call this function from within a string."
(unless limit
(defun ada-goto-stmt-end (&optional limit)
- "Moves point to the end of the statement that point is in or before.
-Returns the new position of point or nil if not found.
+ "Move point to the end of the statement that point is in or before.
+Return the new position of point or nil if not found.
Stop the search at LIMIT."
(if (ada-search-ignore-string-comment ada-end-stmt-re nil limit)
(point)
(defun ada-goto-next-word (&optional backward)
- "Moves point to the beginning of the next word of Ada code.
+ "Move point to the beginning of the next word of Ada code.
If BACKWARD is non-nil, jump to the beginning of the previous word.
-Returns the new position of point or nil if not found."
+Return the new position of point or nil if not found."
(let ((match-cons nil)
(orgpoint (point))
(old-syntax (char-to-string (char-syntax ?_))))
(defun ada-check-matching-start (keyword)
- "Signals an error if matching block start is not KEYWORD.
+ "Signal an error if matching block start is not KEYWORD.
Moves point to the matching block start."
(ada-goto-matching-start 0)
(unless (looking-at (concat "\\<" keyword "\\>"))
- (error "matching start is not '%s'" keyword)))
+ (error "Matching start is not '%s'" keyword)))
(defun ada-check-defun-name (defun-name)
- "Checks if the name of the matching defun really is DEFUN-NAME.
-Assumes point to be already positioned by 'ada-goto-matching-start'.
+ "Check if the name of the matching defun really is DEFUN-NAME.
+Assumes point to be already positioned by `ada-goto-matching-start'.
Moves point to the beginning of the declaration."
;; named block without a `declare'
;; should be looking-at the correct name
;;
(unless (looking-at (concat "\\<" defun-name "\\>"))
- (error "matching defun has different name: %s"
+ (error "Matching defun has different name: %s"
(buffer-substring (point)
(progn (forward-sexp 1) (point))))))))
(defun ada-goto-matching-decl-start (&optional noerror recursive)
- "Moves point to the matching declaration start of the current 'begin'.
+ "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."
(let ((nest-count 1)
;; "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))
(looking-at "declare\\|generic")))
t
(if noerror nil
- (error "no matching proc/func/task/declare/package/protected")))
+ (error "No matching proc/func/task/declare/package/protected")))
))
(defun ada-goto-matching-start (&optional nest-level noerror gotothen)
- "Moves point to the beginning of a block-start.
-Which block depends on the value of NEST-LEVEL, which defaults to zero. If
-NOERROR is non-nil, it only returns nil if no matching start was found.
+ "Move point to the beginning of a block-start.
+Which block depends on the value of NEST-LEVEL, which defaults to zero.
+If NOERROR is non-nil, it only returns nil if no matching start was found.
If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
(let ((nest-count (if nest-level nest-level 0))
(found 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'
;;
(unless (ada-search-ignore-string-comment
"accept" t nil nil
'word-search-backward)
- (error "missing 'accept' in front of 'do'"))))
+ (error "Missing 'accept' in front of 'do'"))))
(point))
-
+
(if noerror
nil
- (error "no matching start"))))))
+ (error "No matching start"))))))
(defun ada-goto-matching-end (&optional nest-level noerror)
- "Moves point to the end of a block.
+ "Move point to the end of a block.
Which block depends on the value of NEST-LEVEL, which defaults to zero.
If NOERROR is non-nil, it only returns nil if found no matching start."
(let ((nest-count (or nest-level 0))
"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))
t
(if noerror
nil
- (error "no matching end")))
+ (error "No matching end")))
))
(defun ada-search-ignore-string-comment
(search-re &optional backward limit paramlists search-func)
"Regexp-search for SEARCH-RE, ignoring comments, strings.
-If PARAMLISTS is nil, ignore parameter lists. Returns a cons cell of
+If PARAMLISTS is nil, ignore parameter lists. Returns a cons cell of
begin and end of match data or nil, if not found.
The search is done using SEARCH-FUNC, which should search backward if
-BACKWARD is non-nil, forward otherwise. SEARCH-FUNC can be optimized in case
-we are searching for a constant string.
+BACKWARD is non-nil, forward otherwise. SEARCH-FUNC can be optimized
+in case we are searching for a constant string.
The search stops at pos LIMIT.
-Point is moved at the beginning of the search-re."
+Point is moved at the beginning of the SEARCH-RE."
(let (found
begin
end
;; 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)
;; -------------------------------------------------------
(defun ada-in-decl-p ()
- "Returns t if point is inside a declarative part.
+ "Return t if point is inside a declarative part.
Assumes point to be at the end of a statement."
(or (ada-in-paramlist-p)
(save-excursion
(defun ada-looking-at-semi-or ()
- "Returns t if looking-at an 'or' following a semicolon."
+ "Return t if looking at an 'or' following a semicolon."
(save-excursion
(and (looking-at "\\<or\\>")
(progn
(defun ada-looking-at-semi-private ()
- "Returns t if looking at the start of a private section in a package.
+ "Return t if looking at the start of a private section in a package.
Returns nil if the private is part of the package name, as in
'private package A is...' (this can only happen at top level)."
(save-excursion
(defun ada-in-paramlist-p ()
- "Returns t if point is inside a parameter-list."
+ "Return t if point is inside a parameter-list."
(save-excursion
(and
(ada-search-ignore-string-comment "(\\|)" t nil t)
result))
(defun ada-in-open-paren-p ()
- "Returns the position of the first non-ws behind the last unclosed
+ "Return the position of the first non-ws behind the last unclosed
parenthesis, or nil."
(save-excursion
(let ((parse (parse-partial-sexp
;; Value_1);
;; type B is ( -- comment
;; Value_2);
-
+
(if (or (not ada-indent-handle-comment-special)
(not (looking-at "[ \t]+--")))
(skip-chars-forward " \t"))
(defun ada-tab ()
"Do indenting or tabbing according to `ada-tab-policy'.
In Transient Mark mode, if the mark is active, operate on the contents
-of the region. Otherwise, operates only on the current line."
+of the region. Otherwise, operate only on the current line."
(interactive)
(cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
((eq ada-tab-policy 'indent-auto)
(if (ada-region-selected)
(ada-indent-region (region-beginning) (region-end))
(ada-indent-current)))
- ((eq ada-tab-policy 'always-tab) (error "not implemented"))
+ ((eq ada-tab-policy 'always-tab) (error "Not implemented"))
))
(defun ada-untab (arg)
"Delete leading indenting according to `ada-tab-policy'."
(interactive "P")
(cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard))
- ((eq ada-tab-policy 'indent-auto) (error "not implemented"))
- ((eq ada-tab-policy 'always-tab) (error "not implemented"))
+ ((eq ada-tab-policy 'indent-auto) (error "Not implemented"))
+ ((eq ada-tab-policy 'always-tab) (error "Not implemented"))
))
(defun ada-indent-current-function ()
- "Ada mode version of the indent-line-function."
+ "Ada mode version of the `indent-line-function'."
(interactive "*")
(let ((starting-point (point-marker)))
(beginning-of-line)
(forward-char ada-indent)))
(defun ada-untab-hard ()
- "indent current line to previous tab stop."
+ "Indent current line to previous tab stop."
(interactive)
(let ((bol (save-excursion (progn (beginning-of-line) (point))))
(eol (save-excursion (progn (end-of-line) (point)))))
(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))
;; -------------------------------------------------------------
(defun ada-move-to-start ()
- "Moves point to the matching start of the current Ada structure."
+ "Move point to the matching start of the current Ada structure."
(interactive)
(let ((pos (point))
(previous-syntax-table (syntax-table)))
(or (looking-at "[ \t]*\\<end\\>")
(backward-word 1))
(or (looking-at "[ \t]*\\<end\\>")
- (error "not on end ...;")))
+ (error "Not on end ...;")))
(ada-goto-matching-start 1)
(setq pos (point))
(set-syntax-table previous-syntax-table))))
(defun ada-move-to-end ()
- "Moves point to the matching end of the block around point.
+ "Move point to the matching end of the block around point.
Moves to 'begin' if in a declarative part."
(interactive)
(let ((pos (point))
(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)))
(set-syntax-table previous-syntax-table))))
(defun ada-next-procedure ()
- "Moves point to next procedure."
+ "Move point to next procedure."
(interactive)
(end-of-line)
(if (re-search-forward ada-procedure-start-regexp nil t)
(error "No more functions/procedures/tasks")))
(defun ada-previous-procedure ()
- "Moves point to previous procedure."
+ "Move point to previous procedure."
(interactive)
(beginning-of-line)
(if (re-search-backward ada-procedure-start-regexp nil t)
(error "No more functions/procedures/tasks")))
(defun ada-next-package ()
- "Moves point to next package."
+ "Move point to next package."
(interactive)
(end-of-line)
(if (re-search-forward ada-package-start-regexp nil t)
(error "No more packages")))
(defun ada-previous-package ()
- "Moves point to previous package."
+ "Move point to previous package."
(interactive)
(beginning-of-line)
(if (re-search-backward ada-package-start-regexp nil t)
(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."
+ "Fill current comment paragraph and justify each line as well."
(interactive)
(ada-fill-comment-paragraph 'full))
(defun ada-fill-comment-paragraph-postfix ()
- "Fills current comment paragraph and justifies each line as well.
+ "Fill current comment paragraph and justify each line as well.
Adds `ada-fill-comment-postfix' at the end of each line."
(interactive)
(ada-fill-comment-paragraph 'full t))
(defun ada-fill-comment-paragraph (&optional justify postfix)
- "Fills the current comment paragraph.
+ "Fill the current comment paragraph.
If JUSTIFY is non-nil, each line is justified as well.
-If POSTFIX and JUSTIFY are non-nil, `ada-fill-comment-postfix' is appended
-to each filled and justified line.
+If POSTFIX and JUSTIFY are non-nil, `ada-fill-comment-postfix' is appended
+to each line filled and justified.
The paragraph is indented on the first line."
(interactive "P")
;; check if inside comment or just in front a comment
(if (and (not (ada-in-comment-p))
(not (looking-at "[ \t]*--")))
- (error "not inside comment"))
+ (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)))
(defun ada-other-file-name ()
"Return the name of the other file.
-The name returned is the body if current-buffer is the spec, or the spec
-otherwise."
+The name returned is the body if `current-buffer' is the spec,
+or the spec otherwise."
(let ((is-spec nil)
(is-body nil)
;; 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))))))
(defvar ada-last-which-function-line -1
- "Last on which ada-which-function was called")
+ "Last on which `ada-which-function' was called.")
(defvar ada-last-which-function-subprog 0
- "Last subprogram name returned by ada-which-function")
+ "Last subprogram name returned by `ada-which-function'.")
(make-variable-buffer-local 'ada-last-which-function-subprog)
(make-variable-buffer-local 'ada-last-which-function-line)
(defun ada-which-function ()
- "Returns the name of the function whose body the point is in.
+ "Return 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")
(goto-char (point-min))))))
(defun ada-get-body-name (&optional spec-name)
- "Returns the file name for the body of SPEC-NAME.
-If SPEC-NAME is nil, returns the body for the current package.
+ "Return the file name for the body of SPEC-NAME.
+If SPEC-NAME is nil, return the body for the current package.
Returns nil if no body was found."
(interactive)
(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.")
;; ---------------------------------------------------------
(defun ada-outline-level ()
- "This is so that `current-column` DTRT in otherwise-hidden text"
+ "This is so that `current-column' DTRT in otherwise-hidden text."
;; patch from Dave Love <fx@gnu.org>
(let (buffer-invisibility-spec)
(save-excursion
(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
(defun ada-gen-treat-proc (match)
"Make dummy body of a procedure/function specification.
-MATCH is a cons cell containing the start and end location of the last search
-for ada-procedure-start-regexp."
+MATCH is a cons cell containing the start and end locations of the last search
+for `ada-procedure-start-regexp'."
(goto-char (car match))
(let (func-found procname functype)
(cond
(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