;;; 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.47 $
+;; 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
;;; gse@ocsystems.com (Scott Evans)
;;; comar@gnat.com (Cyrille Comar)
;;; stephen.leake@gsfc.nasa.gov (Stephen Leake)
+;;; robin-reply@reagans.org
;;; and others for their valuable hints.
;;; Code:
;;; the customize mode. They are sorted in alphabetical order in this
;;; file.
+;;; Supported packages.
+;;; This package supports a number of other Emacs modes. These other modes
+;;; should be loaded before the ada-mode, which will then setup some variables
+;;; to improve the support for Ada code.
+;;; Here is the list of these modes:
+;;; `which-function-mode': Display the name of the subprogram the cursor is
+;;; in in the mode line.
+;;; `outline-mode': Provides the capability to collapse or expand the code
+;;; for specific language constructs, for instance if you want to hide the
+;;; code corresponding to a subprogram
+;;; `align': This mode is now provided with Emacs 21, but can also be
+;;; installed manually for older versions of Emacs. It provides the
+;;; capability to automatically realign the selected region (for instance
+;;; all ':=', ':' and '--' will be aligned on top of each other.
+;;; `imenu': Provides a menu with the list of entities defined in the current
+;;; buffer, and an easy way to jump to any of them
+;;; `speedbar': Provides a separate file browser, and the capability for each
+;;; file to see the list of entities defined in it and to jump to them
+;;; easily
+;;; `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
-;; (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',
(const ada-no-auto-case))
:group 'ada)
-(defcustom ada-case-exception-file '("~/.emacs_case_exceptions")
+(defcustom ada-case-exception-file
+ (list (convert-standard-filename' "~/.emacs_case_exceptions"))
"*List of special casing exceptions dictionaries for identifiers.
The first file is the one where new exceptions will be saved by Emacs
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. Each line can be terminated by
+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
a comment."
:type '(repeat (file))
:group 'ada)
nil 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.
+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
+a comment and `ada-indent-handle-comment-special' is t.
+
+type A is
+ ( Value_1, -- common behavior, when not a comment
+ Value_2);
+
+type A is
+ ( -- `ada-indent-handle-comment-special' is nil
+ Value_1,
+ Value_2);
+
+type A is
+ ( -- `ada-indent-handle-comment-special' is non-nil
+ 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.
(defvar ada-case-exception '()
"Alist of words (entities) that have special casing.")
+(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
+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.")
"Variable used by find-file to find the name of the other package.
See `ff-other-file-alist'.")
+(defvar ada-align-list
+ '(("[^:]\\(\\s-*\\):[^:]" 1 t)
+ ("[^=]\\(\\s-+\\)=[^=]" 1 t)
+ ("\\(\\s-*\\)use\\s-" 1)
+ ("\\(\\s-*\\)--" 1))
+ "Ada support for align.el <= 2.2
+This variable provides regular expressions on which to align different lines.
+See `align-mode-alist' for more information.")
+
+(defvar ada-align-modes
+ '((ada-declaration
+ (regexp . "[^:]\\(\\s-*\\):[^:]")
+ (valid . (lambda() (not (ada-in-comment-p))))
+ (modes . '(ada-mode)))
+ (ada-assignment
+ (regexp . "[^=]\\(\\s-+\\)=[^=]")
+ (valid . (lambda() (not (ada-in-comment-p))))
+ (modes . '(ada-mode)))
+ (ada-comment
+ (regexp . "\\(\\s-*\\)--")
+ (modes . '(ada-mode)))
+ (ada-use
+ (regexp . "\\(\\s-*\\)use\\s-")
+ (valid . (lambda() (not (ada-in-comment-p))))
+ (modes . '(ada-mode)))
+ )
+ "Ada support for align.el >= 2.8
+This variable defines several rules to use to align different lines.")
+
+(defconst ada-align-region-separate
+ (concat
+ "^\\s-*\\($\\|\\("
+ "begin\\|"
+ "declare\\|"
+ "else\\|"
+ "end\\|"
+ "exception\\|"
+ "for\\|"
+ "function\\|"
+ "generic\\|"
+ "if\\|"
+ "is\\|"
+ "procedure\\|"
+ "record\\|"
+ "return\\|"
+ "type\\|"
+ "when"
+ "\\)\\>\\)")
+ "see the variable `align-region-separate' for more information.")
+
;;; ---- Below are the regexp used in this package for parsing
(defconst ada-83-keywords
"\\(\\sw\\|[_.]\\)+"
"Regexp matching Ada (qualified) identifiers.")
+;; "with" needs to be included in the regexp, so that we can insert new lines
+;; after the declaration of the parameter for a generic.
(defvar ada-procedure-start-regexp
- "^[ \t]*\\(procedure\\|function\\|task\\)[ \t\n]+\\(\\(\\sw\\|[_.]\\)+\\)"
+ (concat
+ "^[ \t]*\\(with[ \t]+\\)?\\(procedure\\|function\\|task\\)[ \t\n]+"
+
+ ;; subprogram name: operator ("[+/=*]")
+ "\\("
+ "\\(\"[^\"]+\"\\)"
+
+ ;; subprogram name: name
+ "\\|"
+ "\\(\\(\\sw\\|[_.]\\)+\\)"
+ "\\)")
"Regexp used to find Ada procedures/functions.")
(defvar ada-package-start-regexp
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
;;------------------------------------------------------------------
;; Support for imenu (see imenu.el)
;;------------------------------------------------------------------
+(defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?")
+
(defconst ada-imenu-subprogram-menu-re
- "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)\\)[ \t\n]*\\(return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?is[ \t\n]")
+ (concat "^[ \t]*\\(procedure\\|function\\)[ \t\n]+"
+ "\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)"
+ ada-imenu-comment-re
+ "\\)[ \t\n]*"
+ "\\(return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?is[ \t\n]"))
(defvar ada-imenu-generic-expression
(list
(concat
"^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)"
"\\("
- "\\([ \t\n]+\\|[ \t\n]*([^)]+)\\)";; parameter list or simple space
+ "\\(" ada-imenu-comment-re "[ \t\n]+\\|[ \t\n]*([^)]+)"
+ ada-imenu-comment-re "\\)";; parameter list or simple space
"\\([ \t\n]*return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?"
"\\)?;") 2)
- '("*Tasks*" "^[ \t]*task[ \t]+\\(\\(body\\|type\\)[ \t]+\\)?\\(\\(\\sw\\|_\\)+\\)" 3)
+ '("*Tasks*" "^[ \t]*task[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
'("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2)
+ '("*Protected*"
+ "^[ \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 two submenus, one
-for type and subtype definitions, the other for subprograms declarations.
-The main menu will reference the bodies of the subprograms.")
-
+See `imenu-generic-expression'. This variable will create several submenus for
+each type of entity that can be found in an Ada file.")
\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)
"Ada mode is the major mode for editing Ada code.
Bindings are as follows: (Note: 'LFD' is control-j.)
+\\{ada-mode-map}
Indent line '\\[ada-tab]'
Indent line, insert newline and indent the new line. '\\[newline-and-indent]'
(set (make-local-variable 'require-final-newline) t)
- (make-local-variable 'comment-start)
- (if ada-fill-comment-prefix
- (setq comment-start ada-fill-comment-prefix)
- (setq comment-start "-- "))
-
;; Set the paragraph delimiters so that one can select a whole block
;; simply with M-h
(set (make-local-variable 'paragraph-start) "[ \t\n\f]*$")
;; 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
- (set (make-local-variable 'comment-padding) 0)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (unless (featurep 'xemacs)
+ (progn
+ (if (ada-check-emacs-version 20 3)
+ (progn
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (set (make-local-variable 'comment-padding) 0)))
+ (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ ))
- (setq case-fold-search t)
- (setq imenu-case-fold-search t)
+ (set 'case-fold-search t)
+ (if (boundp 'imenu-case-fold-search)
+ (set 'imenu-case-fold-search t))
(set (make-local-variable 'fill-paragraph-function)
'ada-fill-comment-paragraph)
(define-key compilation-minor-mode-map "\C-m"
'ada-compile-goto-error)))
- ;; font-lock support
- (set (make-local-variable 'font-lock-defaults)
- '(ada-font-lock-keywords
- nil t
- ((?\_ . "w") (?# . "."))
- beginning-of-line
- (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
+ ;; font-lock support :
+ ;; We need to set some properties for XEmacs, and define some variables
+ ;; for Emacs
+
+ (if (featurep 'xemacs)
+ ;; XEmacs
+ (put 'ada-mode 'font-lock-defaults
+ '(ada-font-lock-keywords
+ nil t ((?\_ . "w") (?# . ".")) beginning-of-line))
+ ;; Emacs
+ (set (make-local-variable 'font-lock-defaults)
+ '(ada-font-lock-keywords
+ nil t
+ ((?\_ . "w") (?# . "."))
+ beginning-of-line
+ (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
+ )
;; Set up support for find-file.el.
(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 ()
- (setq 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 ()
- (setq 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 ()
- (setq 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
;; Support for imenu : We want a sorted index
(setq imenu-sort-function 'imenu--sort-by-name)
- ;; Support for which-function-mode is provided in ada-support (support
- ;; for nested subprograms)
+ ;; Support for ispell : Check only comments
+ (set (make-local-variable 'ispell-check-comments) 'exclusive)
+
+ ;; Support for align.el <= 2.2, if present
+ ;; align.el is distributed with Emacs 21, but not with earlier versions.
+ (if (boundp 'align-mode-alist)
+ (add-to-list 'align-mode-alist '(ada-mode . ada-align-list)))
+
+ ;; Support for align.el >= 2.8, if present
+ (if (boundp 'align-dq-string-modes)
+ (progn
+ (add-to-list 'align-dq-string-modes 'ada-mode)
+ (add-to-list 'align-open-comment-modes 'ada-mode)
+ (set (make-variable-buffer-local 'align-region-separate)
+ ada-align-region-separate)
+
+ ;; 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)
- (setq major-mode 'ada-mode)
- (setq mode-name "Ada")
+ (setq major-mode 'ada-mode
+ mode-name "Ada")
(use-local-map ada-mode-map)
(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)
+ ;; To be run after the hook, in case the user modified
+ ;; ada-fill-comment-prefix
+ (make-local-variable 'comment-start)
+ (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
- (ada-initialize-properties)
- (add-hook 'font-lock-mode-hook 'ada-deactivate-properties nil t))
+ (unless (featurep 'xemacs)
+ (progn
+ (ada-initialize-properties)
+ (add-hook 'font-lock-mode-hook 'ada-deactivate-properties nil t)))
;; the following has to be done after running the ada-mode-hook
;; because users might want to set the values of these variable
(if ada-auto-case
(ada-activate-keys-for-case)))
+
+;; 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 (featurep 'xemacs) (funcall (symbol-function 'region-active-p)))
+ (and (not (featurep 'xemacs))
+ (symbol-value 'transient-mark-mode)
+ (symbol-value 'mark-active))))
+
\f
;;-----------------------------------------------------------------
;; auto-casing
;; For backward compatibility, this variable can also be a string.
;;-----------------------------------------------------------------
+(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)
+ (mapcar (lambda (x) (insert (car x) "\n"))
+ (sort (copy-sequence ada-case-exception)
+ (lambda(a b) (string< (car a) (car b)))))
+ (mapcar (lambda (x) (insert "*" (car x) "\n"))
+ (sort (copy-sequence ada-case-exception-substring)
+ (lambda(a b) (string< (car a) (car b)))))
+ (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.
The standard casing rules will no longer apply to this word."
(interactive)
(let ((previous-syntax-table (syntax-table))
- (exception-list '())
file-name
)
((listp ada-case-exception-file)
(setq file-name (car ada-case-exception-file)))
(t
- (error "No exception file specified")))
+ (error (concat "No exception file specified. "
+ "See variable ada-case-exception-file."))))
(set-syntax-table ada-mode-symbol-syntax-table)
(unless word
(skip-syntax-backward "w")
(setq word (buffer-substring-no-properties
(point) (save-excursion (forward-word 1) (point))))))
+ (set-syntax-table previous-syntax-table)
;; Reread the exceptions file, in case it was modified by some other,
- ;; and to keep the end-of-line comments that may exist in it.
- (if (file-readable-p (expand-file-name file-name))
- (let ((buffer (current-buffer)))
- (find-file (expand-file-name file-name))
- (set-syntax-table ada-mode-symbol-syntax-table)
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (add-to-list 'exception-list
- (list
- (buffer-substring-no-properties
- (point) (save-excursion (forward-word 1) (point)))
- (buffer-substring-no-properties
- (save-excursion (forward-word 1) (point))
- (save-excursion (end-of-line) (point)))
- t))
- (forward-line 1))
- (kill-buffer nil)
- (set-buffer buffer)))
+ (ada-case-read-exceptions-from-file file-name)
;; If the word is already in the list, even with a different casing
;; we simply want to replace it.
- (if (and (not (equal exception-list '()))
- (assoc-ignore-case word exception-list))
- (setcar (assoc-ignore-case word exception-list)
- word)
- (add-to-list 'exception-list (list word "" t))
- )
-
(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))
)
- ;; Save the list in the file
- (find-file (expand-file-name file-name))
- (erase-buffer)
- (mapcar (lambda (x) (insert (car x) (nth 1 x) "\n"))
- (sort exception-list
- (lambda(a b) (string< (car a) (car b)))))
- (save-buffer)
- (kill-buffer nil)
- (set-syntax-table previous-syntax-table)
+ (ada-save-exceptions-to-file file-name)
))
+(defun ada-create-case-exception-substring (&optional word)
+ "Defines 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'.
+When auto-casing a word, this substring will be special-cased, unless the
+word itself has a special casing."
+ (interactive)
+ (let ((file-name
+ (cond ((stringp ada-case-exception-file)
+ ada-case-exception-file)
+ ((listp ada-case-exception-file)
+ (car ada-case-exception-file))
+ (t
+ (error (concat "No exception file specified. "
+ "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
+ (cond
+ (word nil)
+
+ ((ada-region-selected)
+ (setq word (buffer-substring-no-properties
+ (region-beginning) (region-end))))
+
+ (t
+ (let ((underscore-syntax (char-syntax ?_)))
+ (unwind-protect
+ (progn
+ (modify-syntax-entry ?_ "." (syntax-table))
+ (save-excursion
+ (skip-syntax-backward "w")
+ (set 'word (buffer-substring-no-properties
+ (point)
+ (save-excursion (forward-word 1) (point))))))
+ (modify-syntax-entry ?_ (make-string 1 underscore-syntax)
+ (syntax-table))))))
+
+ ;; Reread the exceptions file, in case it was modified by some other,
+ (ada-case-read-exceptions-from-file file-name)
+
+ ;; 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-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))
+ )
+
+ (ada-save-exceptions-to-file file-name)
+
+ (message (concat "Defining " word " as a casing exception"))))
+
(defun ada-case-read-exceptions-from-file (file-name)
"Read the content of the casing exception file FILE-NAME."
(if (file-readable-p (expand-file-name file-name))
;; priority should be applied to each casing exception
(let ((word (buffer-substring-no-properties
(point) (save-excursion (forward-word 1) (point)))))
- (unless (assoc-ignore-case word ada-case-exception)
- (add-to-list 'ada-case-exception (cons word t))))
+
+ ;; Handling a substring ?
+ (if (char-equal (string-to-char word) ?*)
+ (progn
+ (setq word (substring word 1))
+ (unless (assoc-string word ada-case-exception-substring t)
+ (add-to-list 'ada-case-exception-substring (cons word t))))
+ (unless (assoc-string word ada-case-exception t)
+ (add-to-list 'ada-case-exception (cons word t)))))
(forward-line 1))
(kill-buffer nil)
(interactive)
;; Reinitialize the casing exception list
- (setq ada-case-exception '())
+ (setq ada-case-exception '()
+ ada-case-exception-substring '())
(cond ((stringp ada-case-exception-file)
(ada-case-read-exceptions-from-file ada-case-exception-file))
(mapcar 'ada-case-read-exceptions-from-file
ada-case-exception-file))))
+(defun ada-adjust-case-substring ()
+ "Adjust case of substrings in the previous word."
+ (interactive)
+ (let ((substrings ada-case-exception-substring)
+ (max (point))
+ (case-fold-search t)
+ (underscore-syntax (char-syntax ?_))
+ re)
+
+ (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) t)))
+ (setq substrings (cdr substrings))
+ )
+ )
+ (modify-syntax-entry ?_ (make-string 1 underscore-syntax) (syntax-table)))
+ )))
+
(defun ada-adjust-case-identifier ()
"Adjust case of the previous identifier.
The auto-casing is done according to the value of `ada-case-identifier' and
(interactive)
(if (or (equal ada-case-exception '())
(equal (char-after) ?_))
- (funcall ada-case-identifier -1)
+ (progn
+ (funcall ada-case-identifier -1)
+ (ada-adjust-case-substring))
(progn
(let ((end (point))
(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)
(insert (car match)))
;; Else simply re-case the word
- (funcall ada-case-identifier -1))))))
+ (funcall ada-case-identifier -1)
+ (ada-adjust-case-substring))))))
(defun ada-after-keyword-p ()
"Returns t if cursor is after a keyword that is not an attribute."
(defun ada-adjust-case (&optional force-identifier)
"Adjust the case of the word before the just typed character.
If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier."
- (forward-char -1)
- (if (and (> (point) 1)
- ;; or if at the end of a character constant
- (not (and (eq (char-after) ?')
- (eq (char-before (1- (point))) ?')))
- ;; or if the previous character was not part of a word
- (eq (char-syntax (char-before)) ?w)
- ;; if in a string or a comment
- (not (ada-in-string-or-comment-p))
- )
- (if (save-excursion
- (forward-word -1)
- (or (= (point) (point-min))
- (backward-char 1))
- (= (char-after) ?'))
- (funcall ada-case-attribute -1)
- (if (and
- (not force-identifier) ; (MH)
- (ada-after-keyword-p))
- (funcall ada-case-keyword -1)
- (ada-adjust-case-identifier))))
- (forward-char 1)
+ (if (not (bobp))
+ (progn
+ (forward-char -1)
+ (if (and (not (bobp))
+ ;; or if at the end of a character constant
+ (not (and (eq (following-char) ?')
+ (eq (char-before (1- (point))) ?')))
+ ;; or if the previous character was not part of a word
+ (eq (char-syntax (char-before)) ?w)
+ ;; if in a string or a comment
+ (not (ada-in-string-or-comment-p))
+ )
+ (if (save-excursion
+ (forward-word -1)
+ (or (= (point) (point-min))
+ (backward-char 1))
+ (= (following-char) ?'))
+ (funcall ada-case-attribute -1)
+ (if (and
+ (not force-identifier) ; (MH)
+ (ada-after-keyword-p))
+ (funcall ada-case-keyword -1)
+ (ada-adjust-case-identifier))))
+ (forward-char 1)
+ ))
)
(defun ada-adjust-case-interactive (arg)
(let ((cur-indent (ada-indent-current)))
- (message nil)
- (if (equal (cdr cur-indent) '(0))
- (message "same indentation")
- (message (mapconcat (lambda(x)
- (cond
- ((symbolp x)
- (symbol-name x))
- ((numberp x)
- (number-to-string x))
- ((listp x)
- (concat "- " (symbol-name (cadr x))))
- ))
- (cdr cur-indent)
- " + ")))
+ (let ((line (save-excursion
+ (goto-char (car cur-indent))
+ (count-lines 1 (point)))))
+
+ (if (equal (cdr cur-indent) '(0))
+ (message (concat "same indentation as line " (number-to-string line)))
+ (message (mapconcat (lambda(x)
+ (cond
+ ((symbolp x)
+ (symbol-name x))
+ ((numberp x)
+ (number-to-string x))
+ ((listp x)
+ (concat "- " (symbol-name (cadr x))))
+ ))
+ (cdr cur-indent)
+ " + "))))
(save-excursion
(goto-char (car cur-indent))
(sit-for 1))))
;; 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))
)
;; check if we have something like this (Table_Component_Type =>
;; Source_File_Record)
(save-excursion
- (if (and (skip-chars-backward " \t")
- (= (char-before) ?\n)
- (not (forward-comment -10000))
- (= (char-before) ?>))
- ;; ??? Could use a different variable
- (list column 'ada-broken-indent)
- (list column 0))))
+
+ ;; Align the closing parenthesis on the opening one
+ (if (= (following-char) ?\))
+ (save-excursion
+ (goto-char column)
+ (skip-chars-backward " \t")
+ (list (1- (point)) 0))
+
+ (if (and (skip-chars-backward " \t")
+ (= (char-before) ?\n)
+ (not (forward-comment -10000))
+ (= (char-before) ?>))
+ ;; ??? Could use a different variable
+ (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
;; starting with e
;;---------------------------
- ((= (char-after) ?e)
+ ((= (downcase (char-after)) ?e)
(cond
;; ------- end ------
(if (looking-at ada-named-block-re)
(setq label (- ada-label-indent))))))))
- (list (+ (save-excursion (back-to-indentation) (point)) label) 0))))
+ ;; 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
+ ;; beginning of the type declaration)
+ ;; type A is (B : Integer;
+ ;; C : Integer) is record
+ ;; end record; -- This is badly indented otherwise
+ (if (looking-at "record")
+ (if (save-excursion
+ (beginning-of-line)
+ (looking-at "^[ \t]*\\(record\\|limited record\\)"))
+ (list (save-excursion (back-to-indentation) (point)) 0)
+ (list (save-excursion
+ (car (ada-search-ignore-string-comment "\\<type\\>" t)))
+ 0))
+
+ ;; Else keep the same indentation as the beginning statement
+ (list (+ (save-excursion (back-to-indentation) (point)) label) 0)))))
;; ------ exception ----
;; starting with w (when)
;;---------------------------
- ((and (= (char-after) ?w)
+ ((and (= (downcase (char-after)) ?w)
(looking-at "when\\>"))
(save-excursion
(ada-goto-matching-start 1)
;; starting with t (then)
;;---------------------------
- ((and (= (char-after) ?t)
+ ((and (= (downcase (char-after)) ?t)
(looking-at "then\\>"))
(if (save-excursion (ada-goto-previous-word)
(looking-at "and\\>"))
;; starting with l (loop)
;;---------------------------
- ((and (= (char-after) ?l)
+ ((and (= (downcase (char-after)) ?l)
(looking-at "loop\\>"))
(setq pos (point))
(save-excursion
(ada-indent-on-previous-lines nil orgpoint orgpoint)
(list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent)))))
+ ;;----------------------------
+ ;; starting with l (limited) or r (record)
+ ;;----------------------------
+
+ ((or (and (= (downcase (char-after)) ?l)
+ (looking-at "limited\\>"))
+ (and (= (downcase (char-after)) ?r)
+ (looking-at "record\\>")))
+
+ (save-excursion
+ (ada-search-ignore-string-comment
+ "\\<\\(type\\|use\\)\\>" t nil)
+ (if (looking-at "\\<use\\>")
+ (ada-search-ignore-string-comment "for" t nil nil
+ 'word-search-backward))
+ (list (progn (back-to-indentation) (point))
+ 'ada-indent-record-rel-type)))
+
;;---------------------------
;; starting with b (begin)
;;---------------------------
- ((and (= (char-after) ?b)
+ ((and (= (downcase (char-after)) ?b)
(looking-at "begin\\>"))
(save-excursion
(if (ada-goto-matching-decl-start t)
;; starting with i (is)
;;---------------------------
- ((and (= (char-after) ?i)
+ ((and (= (downcase (char-after)) ?i)
(looking-at "is\\>"))
(if (and ada-indent-is-separate
(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 (record, return, renames)
+ ;; starting with r (return, renames)
;;---------------------------
- ((= (char-after) ?r)
-
- (cond
-
- ;; ----- record ------
-
- ((looking-at "record\\>")
- (save-excursion
- (ada-search-ignore-string-comment
- "\\<\\(type\\|use\\)\\>" t nil)
- (if (looking-at "\\<use\\>")
- (ada-search-ignore-string-comment "for" t nil nil 'word-search-backward))
- (list (progn (back-to-indentation) (point)) 'ada-indent-record-rel-type)))
-
- ;; ----- return or renames ------
-
- ((looking-at "re\\(turn\\|names\\)\\>")
- (save-excursion
- (let ((var 'ada-indent-return))
- ;; If looking at a renames, skip the 'return' statement too
- (if (looking-at "renames")
- (let (pos)
- (save-excursion
- (setq pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
- (if (and pos
- (= (char-after (car pos)) ?r))
- (goto-char (car pos)))
- (setq var 'ada-indent-renames)))
+ ((and (= (downcase (char-after)) ?r)
+ (looking-at "re\\(turn\\|names\\)\\>"))
- (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))
- (if (and (= (char-after) ?\()
- (save-excursion
- (or (progn
- (backward-word 1)
- (looking-at "function\\>"))
- (progn
- (backward-word 1)
- (setq num-back 2)
- (looking-at "function\\>")))))
-
- ;; 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
- (if (and (> (eval var) 0)
- (save-excursion (forward-word -1)
- (looking-at "function\\>")))
- (list (progn (forward-word -1) (point)) var)
-
- ;; Else...
- (ada-indent-on-previous-lines nil orgpoint orgpoint)))))))
- ))
+ (save-excursion
+ (let ((var 'ada-indent-return))
+ ;; If looking at a renames, skip the 'return' statement too
+ (if (looking-at "renames")
+ (let (pos)
+ (save-excursion
+ (set 'pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
+ (if (and pos
+ (= (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))
+ (if (and (= (following-char) ?\()
+ (save-excursion
+ (or (progn
+ (backward-word 1)
+ (looking-at "\\(function\\|procedure\\)\\>"))
+ (progn
+ (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
+ (if (and (> (eval var) 0)
+ (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'
;; 'private' as statement-start
;;--------------------------------
- ((and (or (= (char-after) ?o)
- (= (char-after) ?p))
+ ((and (or (= (downcase (char-after)) ?o)
+ (= (downcase (char-after)) ?p))
(or (ada-looking-at-semi-or)
(ada-looking-at-semi-private)))
(save-excursion
- (ada-goto-matching-start 1)
- (list (progn (back-to-indentation) (point)) 0)))
+ ;; ??? Wasn't this done already in ada-looking-at-semi-or ?
+ (ada-goto-matching-start 1)
+ (list (progn (back-to-indentation) (point)) 0)))
;;--------------------------------
;; starting with 'd' (do)
;;--------------------------------
- ((and (= (char-after) ?d)
+ ((and (= (downcase (char-after)) ?d)
(looking-at "do\\>"))
(save-excursion
(ada-goto-stmt-start)
;; package/function/procedure
;;---------------------------------
- ((and (or (= (char-after) ?p) (= (char-after) ?f))
+ ((and (or (= (downcase (char-after)) ?p) (= (downcase (char-after)) ?f))
(looking-at "\\<\\(package\\|function\\|procedure\\)\\>"))
(save-excursion
;; Go up until we find either a generic section, or the end of the
;;
((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
(ada-goto-next-non-ws)
(list (point) 0))
+ ;; After an affectation (default parameter value in subprogram
+ ;; declaration)
+ ((and (= (following-char) ?=) (= (preceding-char) ?:))
+ (back-to-indentation)
+ (list (point) 'ada-broken-indent))
+
;; inside a parameter declaration
(t
(goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
(ada-goto-next-non-ws)
- (list (point) 'ada-broken-indent)))))
+ (list (point) 0)))))
(defun ada-get-indent-end (orgpoint)
"Calculates the indentation when point is just before an end_statement.
(setq indent (list (point) 0))
(if (ada-goto-matching-decl-start t)
(list (progn (back-to-indentation) (point)) 0)
- indent)))))
+ indent))
+ (list (progn (back-to-indentation) (point)) 0)
+ )))
;;
;; anything else - should maybe signal an error ?
;;
(while (and (setq match-cons (ada-search-ignore-string-comment
"\\<\\(then\\|and[ \t]*then\\)\\>"
nil orgpoint))
- (= (char-after (car match-cons)) ?a)))
+ (= (downcase (char-after (car match-cons))) ?a)))
;; If "then" was found (we are looking at it)
(if match-cons
(progn
(save-excursion
(ada-indent-on-previous-lines t orgpoint)))
+ ;; Special case for record types, for instance for:
+ ;; type A is (B : Integer;
+ ;; C : Integer) is record
+ ;; null; -- This is badly indented otherwise
+ ((looking-at "record")
+
+ ;; If record is at the beginning of the line, indent from there
+ (if (save-excursion
+ (beginning-of-line)
+ (looking-at "^[ \t]*\\(record\\|limited record\\)"))
+ (list (save-excursion (back-to-indentation) (point)) 'ada-indent)
+
+ ;; else indent relative to the type command
+ (list (save-excursion
+ (car (ada-search-ignore-string-comment "\\<type\\>" t)))
+ 'ada-indent)))
+
;; nothing follows the block-start
(t
(list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))
"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)
-
- (save-excursion
- (goto-char (cdr match-dat))
- (ada-goto-next-non-ws)
- (looking-at "(")
- ;; words that can go after an 'is'
- (unless (looking-at
- (eval-when-compile
- (concat "\\<"
- (regexp-opt '("separate" "access" "array"
- "abstract" "new") t)
- "\\>\\|(")))
- (setq found t))))
- ))
+ (cond
+
+ ((and (looking-at
+ "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")
+ (save-excursion
+ (ada-goto-previous-word)
+ (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]")))
+ (forward-word -1))
+
+ ((looking-at "is")
+ (setq found
+ (and (save-excursion (ada-goto-previous-word)
+ (ada-goto-previous-word)
+ (not (looking-at "subtype")))
+
+ (save-excursion (goto-char (cdr match-dat))
+ (ada-goto-next-non-ws)
+ ;; words that can go after an 'is'
+ (not (looking-at
+ (eval-when-compile
+ (concat "\\<"
+ (regexp-opt
+ '("separate" "access" "array"
+ "abstract" "new") t)
+ "\\>\\|("))))))))
+
+ (t
+ (setq found t))
+ )))
(if found
match-dat
"Moves 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)
+
+ ;; first should be set to t if we should stop at the first
+ ;; "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
t)
(if (looking-at "end")
- (ada-goto-matching-decl-start noerror t)
+ (ada-goto-matching-start 1 noerror t)
+ ;; (ada-goto-matching-decl-start noerror t)
(setq loop-again nil)
(unless (looking-at "begin")
;;
((looking-at "declare\\|generic")
(setq nest-count (1- nest-count))
- (setq first nil))
+ (setq first t))
;;
((looking-at "is")
;; check if it is only a type definition, but not a protected
(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\\>"))))
(setq nest-count 0))
;;
((looking-at "when")
- (if stop-at-when
- (setq nest-count (1- nest-count)))
- (setq first nil))
+ (save-excursion
+ (forward-word -1)
+ (unless (looking-at "\\<exit[ \t\n]*when\\>")
+ (progn
+ (if stop-at-when
+ (setq nest-count (1- nest-count)))
+ ))))
+ ;;
+ ((looking-at "begin")
+ (setq first nil))
;;
(t
(setq nest-count (1+ nest-count))
(ada-goto-previous-word)
(if (looking-at "\\<end\\>[ \t]*[^;]")
;; it ends a block => increase nest depth
- (progn
- (setq nest-count (1+ nest-count))
- (setq pos (point)))
+ (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)
(ada-goto-next-non-ws)
;; ignore it if it is only a declaration with 'new'
- (if (not (looking-at "\\<\\(new\\|separate\\)\\>"))
+ ;; We could have package Foo is new ....
+ ;; or package Foo is separate;
+ ;; or package Foo is begin null; end Foo
+ ;; for elaboration code (elaboration)
+ (if (not (looking-at "\\<\\(new\\|separate\\|begin\\)\\>"))
(setq nest-count (1- nest-count)))))))
;; found task start => check if it has a body
((looking-at "task")
;;
(setq found (zerop nest-count))))) ; end of loop
- (if found
- ;;
- ;; match found => is there anything else to do ?
- ;;
- (progn
- (cond
- ;;
- ;; found 'if' => skip to 'then', if it's on a separate line
- ;; and GOTOTHEN is non-nil
- ;;
- ((and
- gotothen
- (looking-at "if")
- (save-excursion
- (ada-search-ignore-string-comment "then" nil nil nil
- 'word-search-forward)
- (back-to-indentation)
- (looking-at "\\<then\\>")))
- (goto-char (match-beginning 0)))
- ;;
- ;; found 'do' => skip back to 'accept'
- ;;
- ((looking-at "do")
- (unless (ada-search-ignore-string-comment "accept" t nil nil
- 'word-search-backward)
- (error "missing 'accept' in front of 'do'"))))
- (point))
-
- (if noerror
- nil
- (error "no matching start")))))
+ (if (bobp)
+ (point)
+ (if found
+ ;;
+ ;; match found => is there anything else to do ?
+ ;;
+ (progn
+ (cond
+ ;;
+ ;; found 'if' => skip to 'then', if it's on a separate line
+ ;; and GOTOTHEN is non-nil
+ ;;
+ ((and
+ gotothen
+ (looking-at "if")
+ (save-excursion
+ (ada-search-ignore-string-comment "then" nil nil nil
+ 'word-search-forward)
+ (back-to-indentation)
+ (looking-at "\\<then\\>")))
+ (goto-char (match-beginning 0)))
+
+ ;;
+ ;; found 'do' => skip back to 'accept'
+ ;;
+ ((looking-at "do")
+ (unless (ada-search-ignore-string-comment
+ "accept" t nil nil
+ 'word-search-backward)
+ (error "missing 'accept' in front of 'do'"))))
+ (point))
+
+ (if noerror
+ nil
+ (error "no matching start"))))))
(defun ada-goto-matching-end (&optional nest-level noerror)
"Moves 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 (if nest-level nest-level 0))
- (found nil))
+ (let ((nest-count (or nest-level 0))
+ (regex (eval-when-compile
+ (concat "\\<"
+ (regexp-opt '("end" "loop" "select" "begin" "case"
+ "if" "task" "package" "record" "do"
+ "procedure" "function") t)
+ "\\>")))
+ found
+ pos
+
+ ;; First is used for subprograms: they are generally handled
+ ;; recursively, but of course we do not want to do that the
+ ;; first time (see comment below about subprograms)
+ (first (not (looking-at "declare"))))
+
+ ;; If we are already looking at one of the keywords, this shouldn't count
+ ;; 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 (looking-at "\\<if\\|loop\\|case\\|begin\\>")
+ (forward-char 1))
;;
;; search forward for interesting keywords
;;
(while (and
(not found)
- (ada-search-ignore-string-comment
- (eval-when-compile
- (concat "\\<"
- (regexp-opt '("end" "loop" "select" "begin" "case"
- "if" "task" "package" "record" "do") t)
- "\\>")) nil))
+ (ada-search-ignore-string-comment regex nil))
;;
;; calculate nest-depth
;;
(backward-word 1)
(cond
+ ;; procedures and functions need to be processed recursively, in
+ ;; case they are defined in a declare/begin block, as in:
+ ;; declare -- NL 0 (nested level)
+ ;; A : Boolean;
+ ;; procedure B (C : D) is
+ ;; begin -- NL 1
+ ;; null;
+ ;; end B; -- NL 0, and we would exit
+ ;; begin
+ ;; end; -- we should exit here
+ ;; processing them recursively avoids the need for any special
+ ;; 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\\|;")
+ (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))
- ;; skip the following keyword
- (if (progn
- (skip-chars-forward "end")
- (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
+ (setq nest-count (1- nest-count)
+ found (<= nest-count 0))
+ ;; skip the following keyword
+ (if (progn
+ (skip-chars-forward "end")
+ (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\\>")
(ada-search-ignore-string-comment "is" nil nil nil
'word-search-forward)
;; ignore and skip it if it is only a 'new' package
(if (looking-at "\\<new\\>")
(goto-char (match-end 0))
- (setq nest-count (1+ nest-count))))
+ (setq nest-count (1+ nest-count)
+ found (<= nest-count 0))))
+
;; all the other block starts
(t
- (setq nest-count (1+ nest-count))
+ (if (not first)
+ (setq nest-count (1+ nest-count)))
+ (setq found (<= nest-count 0))
(forward-word 1))) ; end of 'cond'
- ;; match is found, if nest-depth is zero
- ;;
- (setq found (zerop nest-count))) ; end of loop
+ (setq first nil))
(if found
t
;; 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)
;; Make sure this is the start of a private section (ie after
;; a semicolon or just after the package declaration, but not
;; after a 'type ... is private' or 'is new ... with private'
+ ;;
+ ;; Note that a 'private' statement at the beginning of the buffer
+ ;; does not indicate a private section, since this is instead a
+ ;; 'private procedure ...'
(progn (forward-comment -1000)
- (or (= (char-before) ?\;)
- (and (forward-word -3)
- (looking-at "\\<package\\>")))))))
+ (and (not (bobp))
+ (or (= (char-before) ?\;)
+ (and (forward-word -3)
+ (looking-at "\\<package\\>"))))))))
(defun ada-in-paramlist-p ()
;; subprogram definition: procedure .... (
;; Let's skip back over the first one
(progn
- (skip-syntax-backward " ")
+ (skip-chars-backward " \t\n")
(if (= (char-before) ?\")
(backward-char 3)
(backward-word 1))
(if (nth 1 parse)
(progn
(goto-char (1+ (nth 1 parse)))
- (skip-chars-forward " \t")
+
+ ;; Skip blanks, if they are not followed by a comment
+ ;; See:
+ ;; type A is ( Value_0,
+ ;; Value_1);
+ ;; type B is ( -- comment
+ ;; Value_2);
+
+ (if (or (not ada-indent-handle-comment-special)
+ (not (looking-at "[ \t]+--")))
+ (skip-chars-forward " \t"))
+
(point))))))
\f
(interactive)
(cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
((eq ada-tab-policy 'indent-auto)
- ;; transient-mark-mode and mark-active are not defined in XEmacs
- (if (or (and ada-xemacs (funcall (symbol-function 'region-active-p)))
- (and (not ada-xemacs)
- (symbol-value 'transient-mark-mode)
- (symbol-value 'mark-active)))
+ (if (ada-region-selected)
(ada-indent-region (region-beginning) (region-end))
(ada-indent-current)))
((eq ada-tab-policy 'always-tab) (error "not implemented"))
;; -- Miscellaneous
;; ------------------------------------------------------------
+;; Not needed any more for Emacs 21.2, but still needed for backward
+;; compatibility
+(defun ada-remove-trailing-spaces ()
+ "Remove trailing spaces in the whole buffer."
+ (interactive)
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward "[ \t]+$" (point-max) t)
+ (replace-match "" nil nil))))))
+
(defun ada-gnat-style ()
"Clean up comments, `(' and `,' for GNAT style checking switch."
(interactive)
(save-excursion
+
+ ;; The \n is required, or the line after an empty comment line is
+ ;; simply ignored.
(goto-char (point-min))
- (while (re-search-forward "--[ \t]*\\([^-]\\)" nil t)
- (replace-match "-- \\1"))
+ (while (re-search-forward "--[ \t]*\\([^-\n]\\)" nil t)
+ (replace-match "-- \\1")
+ (forward-line 1)
+ (beginning-of-line))
+
(goto-char (point-min))
(while (re-search-forward "\\>(" nil t)
- (replace-match " ("))
+ (if (not (ada-in-string-or-comment-p))
+ (replace-match " (")))
+ (goto-char (point-min))
+ (while (re-search-forward ";--" nil t)
+ (forward-char -1)
+ (if (not (ada-in-string-or-comment-p))
+ (replace-match "; --")))
(goto-char (point-min))
(while (re-search-forward "([ \t]+" nil t)
- (replace-match "("))
+ (if (not (ada-in-string-or-comment-p))
+ (replace-match "(")))
(goto-char (point-min))
(while (re-search-forward ")[ \t]+)" nil t)
- (replace-match "))"))
+ (if (not (ada-in-string-or-comment-p))
+ (replace-match "))")))
(goto-char (point-min))
(while (re-search-forward "\\>:" nil t)
- (replace-match " :"))
- (goto-char (point-min))
- (while (re-search-forward ",\\<" nil t)
- (replace-match ", "))
+ (if (not (ada-in-string-or-comment-p))
+ (replace-match " :")))
+
+ ;; Make sure there is a space after a ','.
+ ;; Always go back to the beginning of the match, since otherwise
+ ;; a statement like ('F','D','E') is incorrectly modified.
(goto-char (point-min))
- (while (re-search-forward "[ \t]*\\.\\.[ \t]*" nil t)
- (replace-match " .. "))
+ (while (re-search-forward ",[ \t]*\\(.\\)" nil t)
+ (if (not (save-excursion
+ (goto-char (match-beginning 0))
+ (ada-in-string-or-comment-p)))
+ (replace-match ", \\1")))
+
+ ;; Operators should be surrounded by spaces.
(goto-char (point-min))
- (while (re-search-forward "[ \t]*\\([-:+*/]\\)[ \t]*" nil t)
- (if (not (ada-in-string-or-comment-p))
+ (while (re-search-forward
+ "[ \t]*\\(/=\\|\\*\\*\\|:=\\|\\.\\.\\|[-:+*/]\\)[ \t]*"
+ nil t)
+ (goto-char (match-beginning 1))
+ (if (or (looking-at "--")
+ (ada-in-string-or-comment-p))
(progn
- (forward-char -1)
- (cond
- ((looking-at "/=")
- (replace-match " /= "))
- ((looking-at ":=")
- (replace-match ":= "))
- ((not (looking-at "--"))
- (replace-match " \\1 ")))
- (forward-char 2))))
+ (forward-line 1)
+ (beginning-of-line))
+ (cond
+ ((string= (match-string 1) "/=")
+ (replace-match " /= "))
+ ((string= (match-string 1) "..")
+ (replace-match " .. "))
+ ((string= (match-string 1) "**")
+ (replace-match " ** "))
+ ((string= (match-string 1) ":=")
+ (replace-match " := "))
+ (t
+ (replace-match " \\1 ")))
+ (forward-char 1)))
))
(progn
(set-syntax-table ada-mode-symbol-syntax-table)
- (message "searching for block start ...")
(save-excursion
;;
;; do nothing if in string or comment or not on 'end ...;'
) ; end of save-excursion
;; now really move to the found position
- (goto-char pos)
- (message "searching for block start ... done"))
+ (goto-char pos))
;; restore syntax-table
(set-syntax-table previous-syntax-table))))
Moves to 'begin' if in a declarative part."
(interactive)
(let ((pos (point))
+ decl-start
(previous-syntax-table (syntax-table)))
(unwind-protect
(progn
(set-syntax-table ada-mode-symbol-syntax-table)
- (message "searching for block end ...")
(save-excursion
- (forward-char 1)
(cond
+ ;; Go to the beginning of the current word, and check if we are
;; directly on 'begin'
- ((save-excursion
- (ada-goto-previous-word)
- (looking-at "\\<begin\\>"))
- (ada-goto-matching-end 1))
- ;; on first line of defun declaration
- ((save-excursion
- (and (ada-goto-stmt-start)
- (looking-at "\\<function\\>\\|\\<procedure\\>" )))
- (ada-search-ignore-string-comment "begin" nil nil nil
- 'word-search-forward))
+ ((save-excursion
+ (skip-syntax-backward "w")
+ (looking-at "\\<begin\\>"))
+ (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)
+ ;; We also need to make sure that we ignore nested subprograms
+ ((save-excursion
+ (and (skip-syntax-backward "w")
+ (looking-at "\\<function\\>\\|\\<procedure\\>" )
+ (ada-search-ignore-string-comment "is\\|;")
+ (not (= (char-before) ?\;))
+ ))
+ (skip-syntax-backward "w")
+ (ada-goto-matching-end 0 t))
+
;; on first line of task declaration
((save-excursion
(and (ada-goto-stmt-start)
(ada-goto-matching-end 0))
;; package start
((save-excursion
- (and (ada-goto-matching-decl-start t)
-
(looking-at "\\<package\\>")))
+ (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
- ((save-excursion
- (ada-goto-matching-decl-start t))
- (ada-search-ignore-string-comment "begin" nil nil nil
- 'word-search-forward))
+ (decl-start
+ (goto-char decl-start)
+ (ada-goto-matching-end 0 t))
+
;; (hopefully ;-) everything else
(t
(ada-goto-matching-end 1)))
)
;; now really move to the position found
- (goto-char pos)
- (message "searching for block end ... done"))
+ (goto-char pos))
;; restore syntax-table
(set-syntax-table previous-syntax-table))))
(interactive)
(end-of-line)
(if (re-search-forward ada-procedure-start-regexp nil t)
- (goto-char (match-beginning 1))
+ (goto-char (match-beginning 2))
(error "No more functions/procedures/tasks")))
(defun ada-previous-procedure ()
(interactive)
(beginning-of-line)
(if (re-search-backward ada-procedure-start-regexp nil t)
- (goto-char (match-beginning 1))
+ (goto-char (match-beginning 2))
(error "No more functions/procedures/tasks")))
(defun ada-next-package ()
(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)
- (define-key ada-mode-map [(shift tab)] 'ada-untab)
+ (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)
;; We don't want to make meta-characters case-specific.
(define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer)
(define-key ada-mode-map "\C-c\C-t" 'ada-case-read-exceptions)
(define-key ada-mode-map "\C-c\C-y" 'ada-create-case-exception)
+ (define-key ada-mode-map "\C-c\C-\M-y" 'ada-create-case-exception-substring)
;; On XEmacs, you can easily specify whether DEL should deletes
;; one character forward or one character backward. Take this into
;; 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 Buffer" ada-adjust-case-buffer t]
- ["Create Case Exception" ada-create-case-exception 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)
- (setq 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
- (< arg 0)
+ (listp arg) ;; a prefix with \C-u is of the form '(4), whereas
+ ;; \C-u 2 sets arg to '2' (fixed by S.Leake)
(string= mode-name "Ada"))
(save-excursion
(let ((cs (concat "^[ \t]*" (regexp-quote comment-start))))
;; 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 1)))
+ (comment-region beg end (- (or arg 2)))
(ad-deactivate 'comment-region))
- (comment-region beg end (list (- (or arg 1))))))
+ (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
;; line at the end of the buffer.
- (if (eolp)
+ (if (eobp)
(insert "\n")
(back-to-indentation)))
(beginning-of-line)
(goto-char opos)
;; Find beginning of paragraph
- (beginning-of-line)
- (while (and (not (bobp)) (looking-at "[ \t]*--[ \t]*[^ \t\n]"))
- (forward-line -1))
- ;; If we found a paragraph-separating line,
- ;; don't actually include it in the paragraph.
- (unless (looking-at "[ \t]*--[ \t]*[^ \t\n]")
+ (back-to-indentation)
+ (while (and (not (bobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
+ (forward-line -1)
+ (back-to-indentation))
+
+ ;; We want one line above the first one, unless we are at the beginning
+ ;; of the buffer
+ (unless (bobp)
(forward-line 1))
+ (beginning-of-line)
(setq from (point-marker))
;; Calculate the indentation we will need for the paragraph
(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)))
(setq is-spec name)
(while suffixes
- (if (file-exists-p (concat name (car suffixes)))
- (setq is-spec (concat name (car suffixes))))
+
+ ;; If we are using project file, search for the other file in all
+ ;; the possible src directories.
+
+ (if (fboundp 'ada-find-src-file-in-dir)
+ (let ((other
+ (ada-find-src-file-in-dir
+ (file-name-nondirectory (concat name (car suffixes))))))
+ (if other
+ (set 'is-spec other)))
+
+ ;; Else search in the current directory
+ (if (file-exists-p (concat name (car suffixes)))
+ (setq is-spec (concat name (car suffixes)))))
(setq suffixes (cdr suffixes)))
is-spec)))
(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.
-Note that this function expects subprogram bodies to be terminated by
-'end <name>;', not 'end;'.
+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
+ func-name indent
found)
;; If this is the same line as before, simply return the same result
(save-excursion
;; In case the current line is also the beginning of the body
(end-of-line)
- (while (and (ada-in-paramlist-p)
- (= (forward-line 1) 0))
- (end-of-line))
+
+ ;; Are we looking at "function Foo\n (paramlist)"
+ (skip-chars-forward " \t\n(")
+
+ (condition-case nil
+ (up-list 1)
+ (error nil))
+
+ (skip-chars-forward " \t\n")
+ (if (looking-at "return")
+ (progn
+ (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")
;; No look for the closest subprogram body that has not ended yet.
- ;; Not that we expect all the bodies to be finished by "end <name",
- ;; not simply "end"
+ ;; Not that we expect all the bodies to be finished by "end <name>",
+ ;; or a simple "end;" indented in the same column as the start of
+ ;; the subprogram. The goal is to be as efficient as possible.
(while (and (not found)
(re-search-backward ada-imenu-subprogram-menu-re nil t))
- (setq func-name (match-string 2))
+
+ ;; Get the function name, but not the properties, or this changes
+ ;; the face in the modeline on Emacs 21
+ (setq func-name (match-string-no-properties 2))
(if (and (not (ada-in-comment-p))
(not (save-excursion
(goto-char (match-end 0))
(looking-at "[ \t\n]*new"))))
(save-excursion
+ (back-to-indentation)
+ (setq indent (current-column))
(if (ada-search-ignore-string-comment
- (concat "end[ \t]+" func-name "[ \t]*;"))
+ (concat "end[ \t]+" func-name "[ \t]*;\\|^"
+ (make-string indent ? ) "end;"))
(setq end-pos (point))
(setq end-pos (point-max)))
(if (>= end-pos pos)
(unless spec-name (setq spec-name (buffer-file-name)))
+ ;; Remove the spec extension. We can not simply remove the file extension,
+ ;; but we need to take into account the specific non-GNAT extensions that the
+ ;; user might have specified.
+
+ (let ((suffixes ada-spec-suffixes)
+ end)
+ (while suffixes
+ (setq end (- (length spec-name) (length (car suffixes))))
+ (if (string-equal (car suffixes) (substring spec-name end))
+ (setq spec-name (substring spec-name 0 end)))
+ (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)))
;; a string
;; This sets the properties of the characters, so that ada-in-string-p
;; correctly handles '"' too...
- '(("\\('\\)[^'\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
+ '(("[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))
))
;;
;; Optional keywords followed by a type name.
(list (concat ; ":[ \t]*"
- "\\<\\(access[ \t]+all\\|access\\|constant\\|in[ \t]+out\\|in\\|out\\)\\>"
+ "\\<\\(access[ \t]+all\\|access[ \t]+constant\\|access\\|constant\\|in[ \t]+reverse\\|\\|in[ \t]+out\\|in\\|out\\)\\>"
"[ \t]*"
"\\(\\sw+\\(\\.\\sw*\\)*\\)?")
'(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
"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.
font-lock-type-face) nil t))
;;
;; Keywords followed by a (comma separated list of) reference.
- (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)\\>" ; "when" removed
- "[ \t\n]*\\(\\(\\sw\\|[_.|, \t\n]\\)+\\)\\W")
+ ;; Note that font-lock only works on single lines, thus we can not
+ ;; correctly highlight a with_clause that spans multiple lines.
+ (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)
+
+ ;; Highlight based-numbers (R. Reagan <robin-reply@reagans.org>)
+ (list "\\([0-9]+#[0-9a-fA-F_]+#\\)" '(1 font-lock-constant-face t))
+
+ ;; 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