(compilation-start): Rely on `cd' to get dir right and also allow argumentless cd.

[gnu-emacs] / lisp / progmodes / ada-mode.el

diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 7707e50ea3b920a52a6bc4ebff296631256af88e..f7688e240696757aa70a38757bce72fb8daed512 100644 (file)
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -1,13 +1,13 @@
 ;;; ada-mode.el --- major-mode for editing Ada sources
 
 ;;; 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>
 ;;  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.46 $
+;; Ada Core Technologies's version:   Revision: 1.188

 ;; Keywords: languages ada
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: languages ada
 
 ;; This file is part of GNU Emacs.


@@ -30,7 +30,7 @@
 ;;; 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
 ;;; 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
 ;;; 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


@@ -94,6 +94,7 @@
 ;;;     gse@ocsystems.com (Scott Evans)
 ;;;     comar@gnat.com (Cyrille Comar)
 ;;;     stephen.leake@gsfc.nasa.gov (Stephen Leake)
 ;;;     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:
 ;;;    and others for their valuable hints.
 
 ;;; Code:


@@ -103,6 +104,34 @@
 ;;;   the customize mode. They are sorted in alphabetical order in this
 ;;;   file.
 
 ;;;   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
 
 ;; this function is needed at compile time
 (eval-and-compile


@@ -118,26 +147,14 @@ If IS-XEMACS is non-nil, check for XEmacs instead of Emacs."
                     (>= emacs-minor-version minor)))))))
 
 
                     (>= 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
 ;;  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.
 
 (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.")
 
 fully loaded.
 This is a good place to add Ada environment specific bindings.")
 


@@ -168,6 +185,15 @@ An example is :
                         >>>>>>>>>Value);  -- from ada-broken-indent"
   :type 'integer :group 'ada)
 
                         >>>>>>>>>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',
 (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',


@@ -179,13 +205,17 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word',
                  (const ada-no-auto-case))
   :group 'ada)
 
                  (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
   "*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)
 a comment."
   :type '(repeat (file))
   :group 'ada)


@@ -244,6 +274,29 @@ For instance:
 nil means do not auto-indent comments."
   :type 'boolean :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)
 (defcustom ada-indent-is-separate t
   "*Non-nil means indent 'is separate' or 'is abstract' if on a single line."
   :type 'boolean :group 'ada)


@@ -298,7 +351,9 @@ with `ada-fill-comment-paragraph-postfix'."
 An example is:
 procedure Foo is
 begin
 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
   :type 'integer :group 'ada)
 
 (defcustom ada-language-version 'ada95


@@ -317,18 +372,25 @@ If nil, no contextual menu is available."
   :group 'ada)
 
 (defcustom ada-search-directories
   :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.
   "*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)
 
   :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-stmt-end-indent 0
   "*Number of columns to indent the end of a statement on a separate line.
 


@@ -429,6 +491,12 @@ This variable is used to define `ada-83-keywords' and `ada-95-keywords'"))
 (defvar ada-case-exception '()
   "Alist of words (entities) that have special casing.")
 
 (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.")
 
 (defvar ada-lfd-binding nil
   "Variable to save key binding of LFD when casing is activated.")
 


@@ -436,6 +504,56 @@ This variable is used to define `ada-83-keywords' and `ada-95-keywords'"))
   "Variable used by find-file to find the name of the other package.
 See `ff-other-file-alist'.")
 
   "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
 ;;; ---- Below are the regexp used in this package for parsing
 
 (defconst ada-83-keywords


@@ -459,8 +577,20 @@ See `ff-other-file-alist'.")
   "\\(\\sw\\|[_.]\\)+"
   "Regexp matching Ada (qualified) identifiers.")
 
   "\\(\\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
 (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
   "Regexp used to find Ada procedures/functions.")
 
 (defvar ada-package-start-regexp


@@ -538,65 +668,37 @@ 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.")
 
 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."
 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)
 ;;------------------------------------------------------------------
 
 
 \f
 ;;------------------------------------------------------------------
 ;; Support for imenu  (see imenu.el)
 ;;------------------------------------------------------------------
 

+(defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?")
+

 (defconst ada-imenu-subprogram-menu-re
 (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
 
 (defvar ada-imenu-generic-expression
   (list


@@ -605,17 +707,18 @@ displaying the menu if point was on an identifier."
          (concat
           "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)"
           "\\("
          (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)
           "\\([ \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)
    '("*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.
    '("*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
 ;;------------------------------------------------------------
 
 \f
 ;;------------------------------------------------------------


@@ -646,15 +749,26 @@ 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))
          (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
           (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))))
           (if (stringp line)
               (goto-line (string-to-number line)))
           (setq source (point-marker))))


@@ -737,7 +851,7 @@ declares it as a word constituent."
 
   ;; See the comment above on grammar related function for the special
   ;; setup for '#'.
 
   ;; 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))
 
       (modify-syntax-entry ?#  "<" ada-mode-syntax-table)
     (modify-syntax-entry ?#  "$" ada-mode-syntax-table))
 


@@ -759,7 +873,7 @@ declares it as a word constituent."
 ;;  Support of special characters in XEmacs (see the comments at the beginning
 ;;  of the section on Grammar related functions).
 
 ;;  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)
     (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants)
       "Handles special character constants and gnatprep statements."
       (let (change)


@@ -814,7 +928,6 @@ as numbers instead of gnatprep comments."
       ;;  Setting this only if font-lock is not set won't work
       ;;  if the user activates or deactivates font-lock-mode,
       ;;  but will make things faster most of the time
       ;;  Setting this only if font-lock is not set won't work
       ;;  if the user activates or deactivates font-lock-mode,
       ;;  but will make things faster most of the time

-      (make-local-hook 'after-change-functions)

       (add-hook 'after-change-functions 'ada-after-change-function nil t)
       )))
 
       (add-hook 'after-change-functions 'ada-after-change-function nil t)
       )))
 


@@ -833,8 +946,7 @@ OLD-LEN indicates what the length of the replaced text was."
         (beginning-of-line)
         (if (looking-at "^[ \t]*#")
             (add-text-properties (match-beginning 0) (match-end 0)
         (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
 
 ;;------------------------------------------------------------------
 ;;  Testing the grammatical context


@@ -844,20 +956,20 @@ OLD-LEN indicates what the length of the replaced text was."
   "Returns t if inside a comment."
   (nth 4 (or parse-result
              (parse-partial-sexp
   "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
 
 (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
 
 (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)))
 
 
   (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
 
 


@@ -902,13 +1014,13 @@ where the mouse button was clicked."
                (save-excursion (skip-syntax-forward "w")
                                (not (ada-after-keyword-p)))
                ))
                (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))
     ))
     (set-buffer (cadr ada-contextual-menu-last-point))
     (goto-char (car ada-contextual-menu-last-point))
     ))


@@ -947,9 +1059,8 @@ name"
 
   ;; Support for speedbar (Specifies that we want to see these files in
   ;; speedbar)
 
   ;; Support for speedbar (Specifies that we want to see these files in
   ;; speedbar)

-  (condition-case nil
+  (if (fboundp 'speedbar-add-supported-extension)

       (progn
       (progn

-        (require 'speedbar)

         (funcall (symbol-function 'speedbar-add-supported-extension)
                  spec)
         (funcall (symbol-function 'speedbar-add-supported-extension)
         (funcall (symbol-function 'speedbar-add-supported-extension)
                  spec)
         (funcall (symbol-function 'speedbar-add-supported-extension)


@@ -962,6 +1073,7 @@ name"
   "Ada mode is the major mode for editing Ada code.
 
 Bindings are as follows: (Note: 'LFD' is control-j.)
   "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]'
 
  Indent line                                          '\\[ada-tab]'
  Indent line, insert newline and indent the new line. '\\[newline-and-indent]'


@@ -1006,11 +1118,6 @@ If you use ada-xref.el:
 
   (set (make-local-variable 'require-final-newline) t)
 
 
   (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]*$")
   ;;  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]*$")


@@ -1040,12 +1147,18 @@ If you use ada-xref.el:
   ;;  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
   ;;  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)
 
   (set (make-local-variable 'fill-paragraph-function)
        'ada-fill-comment-paragraph)


@@ -1066,22 +1179,32 @@ If you use ada-xref.el:
              (define-key compilation-minor-mode-map "\C-m"
                'ada-compile-goto-error)))
 
              (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)
 
   ;; 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
 
   ;; Some special constructs for find-file.el
   ;; We do not need to add the construction for 'with', which is in the


@@ -1095,21 +1218,26 @@ If you use ada-xref.el:
                                "\\(body[ \t]+\\)?"
                                "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
                      (lambda ()
                                "\\(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 ()
   ;; 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,
   ;; 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,


@@ -1120,11 +1248,13 @@ If you use ada-xref.el:
          (assoc "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" ff-special-constructs))
         (new-cdr
          (lambda ()
          (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
     (if old-construct
         (setcdr old-construct new-cdr)
       (add-to-list 'ff-special-constructs


@@ -1139,8 +1269,62 @@ If you use ada-xref.el:
   ;;  Support for imenu : We want a sorted index
   (setq imenu-sort-function 'imenu--sort-by-name)
 
   ;;  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
 
   ;;  Set up the contextual menu
   (if ada-popup-key


@@ -1150,11 +1334,21 @@ If you use ada-xref.el:
   (define-abbrev-table 'ada-mode-abbrev-table ())
   (setq local-abbrev-table ada-mode-abbrev-table)
 
   (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)
 
   ;;  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)
 
 
   (use-local-map ada-mode-map)
 


@@ -1165,20 +1359,27 @@ If you use ada-xref.el:
   (if ada-clean-buffer-before-saving
       (progn
         ;; remove all spaces at the end of lines in the whole buffer.
   (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)
 
         ;; 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
 
   ;;  Run this after the hook to give the users a chance to activate
   ;;  font-lock-mode
 

-  (unless ada-xemacs
-    (ada-initialize-properties)
-    (make-local-hook 'font-lock-mode-hook)
-    (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
 
   ;; the following has to be done after running the ada-mode-hook
   ;; because users might want to set the values of these variable


@@ -1192,6 +1393,15 @@ If you use ada-xref.el:
   (if ada-auto-case
       (ada-activate-keys-for-case)))
 
   (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
 \f
 ;;-----------------------------------------------------------------
 ;;                      auto-casing


@@ -1207,6 +1417,23 @@ If you use ada-xref.el:
 ;; For backward compatibility, this variable can also be a string.
 ;;-----------------------------------------------------------------
 
 ;; 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.
 (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.


@@ -1214,7 +1441,6 @@ 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."
   (interactive)
   (let ((previous-syntax-table (syntax-table))
 The standard casing rules will no longer apply to this word."
   (interactive)
   (let ((previous-syntax-table (syntax-table))

-        (exception-list '())

         file-name
         )
 
         file-name
         )
 


@@ -1223,7 +1449,8 @@ The standard casing rules will no longer apply to this word."
           ((listp ada-case-exception-file)
            (setq file-name (car ada-case-exception-file)))
           (t
           ((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
 
     (set-syntax-table ada-mode-symbol-syntax-table)
     (unless word


@@ -1231,55 +1458,76 @@ The standard casing rules will no longer apply to this word."
         (skip-syntax-backward "w")
         (setq word (buffer-substring-no-properties
                     (point) (save-excursion (forward-word 1) (point))))))
         (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,
 
     ;;  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 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 '()))
     (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))
       )
 
       (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))
 (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))


@@ -1295,8 +1543,15 @@ The standard casing rules will no longer apply to this word."
           ;; priority should be applied to each casing exception
           (let ((word (buffer-substring-no-properties
                        (point) (save-excursion (forward-word 1) (point)))))
           ;; 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)
 
           (forward-line 1))
         (kill-buffer nil)


@@ -1308,7 +1563,8 @@ The standard casing rules will no longer apply to this word."
   (interactive)
 
   ;;  Reinitialize the casing exception list
   (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))
 
   (cond ((stringp ada-case-exception-file)
          (ada-case-read-exceptions-from-file ada-case-exception-file))


@@ -1317,6 +1573,34 @@ The standard casing rules will no longer apply to this word."
          (mapcar '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
 (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


@@ -1324,7 +1608,9 @@ the exceptions defined in `ada-case-exception-file'."
   (interactive)
   (if (or (equal ada-case-exception '())
           (equal (char-after) ?_))
   (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))
 
     (progn
       (let ((end   (point))


@@ -1332,15 +1618,16 @@ the exceptions defined in `ada-case-exception-file'."
                                    (point)))
             match)
         ;;  If we have an exception, replace the word by the correct casing
                                    (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
 
             (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-after-keyword-p ()
   "Returns t if cursor is after a keyword that is not an attribute."


@@ -1354,28 +1641,31 @@ the exceptions defined in `ada-case-exception-file'."
 (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."
 (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)
   )
 
 (defun ada-adjust-case-interactive (arg)


@@ -1882,20 +2172,23 @@ This function is intended to be bound to the \C-m and \C-j keys."
 
   (let ((cur-indent (ada-indent-current)))
 
 
   (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))))
     (save-excursion
       (goto-char (car cur-indent))
       (sit-for 1))))


@@ -1938,7 +2231,7 @@ offset."
 
           ;;  This need to be done here so that the advice is not always
           ;;  activated (this might interact badly with other modes)
 
           ;;  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
               (ad-activate 'parse-partial-sexp t))
 
           (save-excursion


@@ -1985,7 +2278,7 @@ offset."
 
       ;; restore syntax-table
       (set-syntax-table previous-syntax-table)
 
       ;; restore syntax-table
       (set-syntax-table previous-syntax-table)

-      (if ada-xemacs
+      (if (featurep 'xemacs)

           (ad-deactivate 'parse-partial-sexp))
       )
 
           (ad-deactivate 'parse-partial-sexp))
       )
 


@@ -2018,13 +2311,40 @@ offset."
       ;; check if we have something like this  (Table_Component_Type =>
       ;;                                          Source_File_Record)
       (save-excursion
       ;; 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
 
      ;;---------------------------
      ;;   at end of buffer


@@ -2037,7 +2357,7 @@ offset."
      ;;  starting with e
      ;;---------------------------
 
      ;;  starting with e
      ;;---------------------------
 

-     ((= (char-after) ?e)
+     ((= (downcase (char-after)) ?e)

       (cond
 
        ;; -------  end  ------
       (cond
 
        ;; -------  end  ------


@@ -2071,7 +2391,24 @@ offset."
                          (if (looking-at ada-named-block-re)
                              (setq label (- ada-label-indent))))))))
 
                          (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  ----
 
 
        ;; ------  exception  ----
 


@@ -2103,7 +2440,7 @@ offset."
      ;;  starting with w (when)
      ;;---------------------------
 
      ;;  starting with w (when)
      ;;---------------------------
 

-     ((and (= (char-after) ?w)
+     ((and (= (downcase (char-after)) ?w)

           (looking-at "when\\>"))
       (save-excursion
        (ada-goto-matching-start 1)
           (looking-at "when\\>"))
       (save-excursion
        (ada-goto-matching-start 1)


@@ -2114,7 +2451,7 @@ offset."
      ;;   starting with t (then)
      ;;---------------------------
 
      ;;   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\\>"))
           (looking-at "then\\>"))
       (if (save-excursion (ada-goto-previous-word)
                          (looking-at "and\\>"))


@@ -2130,7 +2467,7 @@ offset."
      ;;   starting with l (loop)
      ;;---------------------------
 
      ;;   starting with l (loop)
      ;;---------------------------
 

-     ((and (= (char-after) ?l)
+     ((and (= (downcase (char-after)) ?l)

           (looking-at "loop\\>"))
       (setq pos (point))
       (save-excursion
           (looking-at "loop\\>"))
       (setq pos (point))
       (save-excursion


@@ -2145,11 +2482,29 @@ offset."
               (ada-indent-on-previous-lines nil orgpoint orgpoint)
             (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent)))))
 
               (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)
      ;;---------------------------
 
      ;;---------------------------
      ;;   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)
           (looking-at "begin\\>"))
       (save-excursion
         (if (ada-goto-matching-decl-start t)


@@ -2160,7 +2515,7 @@ offset."
      ;;   starting with i (is)
      ;;---------------------------
 
      ;;   starting with i (is)
      ;;---------------------------
 

-     ((and (= (char-after) ?i)
+     ((and (= (downcase (char-after)) ?i)

           (looking-at "is\\>"))
 
       (if (and ada-indent-is-separate
           (looking-at "is\\>"))
 
       (if (and ada-indent-is-separate


@@ -2174,76 +2529,63 @@ offset."
             (list (progn (back-to-indentation) (point)) 'ada-indent))
         (save-excursion
           (ada-goto-stmt-start)
             (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'
 
      ;;--------------------------------
      ;;   starting with 'o' or 'p'


@@ -2251,19 +2593,20 @@ offset."
      ;;   'private' as statement-start
      ;;--------------------------------
 
      ;;   '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
           (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)
      ;;--------------------------------
 
 
      ;;--------------------------------
      ;;   starting with 'd'  (do)
      ;;--------------------------------
 

-     ((and (= (char-after) ?d)
+     ((and (= (downcase (char-after)) ?d)

           (looking-at "do\\>"))
       (save-excursion
         (ada-goto-stmt-start)
           (looking-at "do\\>"))
       (save-excursion
         (ada-goto-stmt-start)


@@ -2331,7 +2674,7 @@ offset."
      ;; package/function/procedure
      ;;---------------------------------
 
      ;; 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 "\\<\\(package\\|function\\|procedure\\)\\>"))
       (save-excursion
        ;;  Go up until we find either a generic section, or the end of the


@@ -2428,6 +2771,12 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
          ;;
          ((looking-at "separate\\>")
           (ada-get-indent-nochange))
          ;;
          ((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
         ;;
         ((looking-at "with\\>\\|use\\>")
          ;;  Are we still in that statement, or are we in fact looking at


@@ -2469,11 +2818,17 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
       (ada-goto-next-non-ws)
       (list (point) 0))
 
       (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)
      ;; 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.
 
 (defun ada-get-indent-end (orgpoint)
   "Calculates the indentation when point is just before an end_statement.


@@ -2528,7 +2883,9 @@ ORGPOINT is the limit position used in the calculation."
                     (setq indent (list (point) 0))
                     (if (ada-goto-matching-decl-start t)
                         (list (progn (back-to-indentation) (point)) 0)
                     (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 ?
            ;;
            ;;
            ;; anything else - should maybe signal an error ?
            ;;


@@ -2601,7 +2958,7 @@ ORGPOINT is the limit position used in the calculation."
     (while (and (setq match-cons (ada-search-ignore-string-comment
                                   "\\<\\(then\\|and[ \t]*then\\)\\>"
                                   nil orgpoint))
     (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
     ;; If "then" was found (we are looking at it)
     (if match-cons
         (progn


@@ -2632,6 +2989,23 @@ ORGPOINT is the limit position used in the calculation."
       (save-excursion
         (ada-indent-on-previous-lines t orgpoint)))
 
       (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)))))
      ;; nothing follows the block-start
      (t
       (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))


@@ -2846,8 +3220,12 @@ ORGPOINT is the limit position used in the calculation."
                                "record" nil orgpoint nil 'word-search-forward))
              t)))
         (if match-cons
                                "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
        ;;
        ;;
        ;; for..loop
        ;;


@@ -3016,26 +3394,35 @@ match."
 
       (goto-char (car match-dat))
       (unless (ada-in-open-paren-p)
 
       (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
 
     (if found
         match-dat


@@ -3156,9 +3543,12 @@ Moves point to the beginning of the declaration."
   "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)
   "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)
         (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
         )
 
     ;;  Ignore "when" most of the time, except if we are looking at the


@@ -3212,7 +3602,8 @@ If NOERROR is non-nil, it only returns nil if no match was found."
                    t)
 
                   (if (looking-at "end")
                    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")
 
                     (setq loop-again nil)
                     (unless (looking-at "begin")


@@ -3237,7 +3628,7 @@ If NOERROR is non-nil, it only returns nil if no match was found."
        ;;
        ((looking-at "declare\\|generic")
         (setq nest-count (1- nest-count))
        ;;
        ((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
        ;;
        ((looking-at "is")
         ;; check if it is only a type definition, but not a protected


@@ -3259,7 +3650,7 @@ If NOERROR is non-nil, it only returns nil if no match was found."
                   (skip-chars-backward "a-zA-Z0-9_.'")
                   (ada-goto-previous-word)
                   (and
                   (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\\>"))))
                    (save-match-data
                      (ada-goto-previous-word)
                      (not (looking-at "\\<protected\\>"))))


@@ -3281,9 +3672,16 @@ If NOERROR is non-nil, it only returns nil if no match was found."
         (setq nest-count 0))
        ;;
        ((looking-at "when")
         (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))
        ;;
        (t
         (setq nest-count (1+ nest-count))


@@ -3342,9 +3740,9 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
               (ada-goto-previous-word)
               (if (looking-at "\\<end\\>[ \t]*[^;]")
                   ;; it ends a block => increase nest depth
               (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))
                 ;; it starts a block => decrease nest depth
                 (setq nest-count (1- nest-count))))
             (goto-char pos))


@@ -3361,14 +3759,17 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
                   (error (concat
                           "No matching 'is' or 'renames' for 'package' at"
                           " line "
                   (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'
               (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 nest-count (1- nest-count)))))))
            ;; found task start => check if it has a body
            ((looking-at "task")


@@ -3410,73 +3811,123 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
           ;;
           (setq found (zerop nest-count))))) ; end of loop
 
           ;;
           (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."
 
 
 (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)
 
     ;;
     ;; 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
 
       ;;
       ;; 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\\>")
        ;; 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)
        ((looking-at "\\<package\\>")
         (ada-search-ignore-string-comment "is" nil nil nil
                                           'word-search-forward)


@@ -3484,15 +3935,17 @@ If NOERROR is non-nil, it only returns nil if found no matching start."
         ;; ignore and skip it if it is only a 'new' package
         (if (looking-at "\\<new\\>")
             (goto-char (match-end 0))
         ;; 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
        ;; 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'
 
         (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 found
         t


@@ -3543,7 +3996,7 @@ Point is moved at the beginning of the search-re."
        ;; If inside a string, skip it (and the following comments)
        ;;
        ((ada-in-string-p parse-result)
        ;; 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)))
             (search-backward "\"" nil t)
           (goto-char (nth 8 parse-result)))
         (unless backward (forward-sexp 1)))


@@ -3552,7 +4005,7 @@ Point is moved at the beginning of the search-re."
        ;; There is a special code for comments at the end of the file
        ;;
        ((ada-in-comment-p parse-result)
        ;; 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)
             (progn
               (forward-line 1)
               (beginning-of-line)


@@ -3624,10 +4077,15 @@ Returns nil if the private is part of the package name, as in
         ;;  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'
         ;;  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)
         (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 ()
 
 
 (defun ada-in-paramlist-p ()


@@ -3643,7 +4101,7 @@ Returns nil if the private is part of the package name, as in
      ;;  subprogram definition: procedure .... (
      ;; Let's skip back over the first one
      (progn
      ;;  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 (= (char-before) ?\")
            (backward-char 3)
          (backward-word 1))


@@ -3694,7 +4152,18 @@ parenthesis, or nil."
       (if (nth 1 parse)
           (progn
             (goto-char (1+ (nth 1 parse)))
       (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
             (point))))))
 
 \f


@@ -3709,11 +4178,7 @@ of the region.  Otherwise, operates only on the current line."
   (interactive)
   (cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
         ((eq ada-tab-policy 'indent-auto)
   (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"))
              (ada-indent-region (region-beginning) (region-end))
            (ada-indent-current)))
         ((eq ada-tab-policy 'always-tab) (error "not implemented"))


@@ -3760,44 +4225,87 @@ of the region.  Otherwise, operates only on the current line."
 ;; --  Miscellaneous
 ;; ------------------------------------------------------------
 
 ;; --  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
 (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))
     (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)
     (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)
     (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)
     (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)
     (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))
     (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))
     (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
          (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)))

     ))
 
 
     ))
 
 


@@ -3815,7 +4323,6 @@ of the region.  Otherwise, operates only on the current line."
         (progn
           (set-syntax-table ada-mode-symbol-syntax-table)
 
         (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 ...;'
           (save-excursion
             ;;
             ;; do nothing if in string or comment or not on 'end ...;'


@@ -3844,8 +4351,7 @@ of the region.  Otherwise, operates only on the current line."
             )                           ; end of save-excursion
 
           ;; now really move to the found position
             )                           ; 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))))
 
       ;; restore syntax-table
       (set-syntax-table previous-syntax-table))))


@@ -3855,27 +4361,36 @@ of the region.  Otherwise, operates only on the current line."
 Moves to 'begin' if in a declarative part."
   (interactive)
   (let ((pos (point))
 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)
 
         (previous-syntax-table (syntax-table)))
     (unwind-protect
         (progn
           (set-syntax-table ada-mode-symbol-syntax-table)
 

-          (message "searching for block end ...")

           (save-excursion
 
           (save-excursion
 

-            (forward-char 1)

             (cond
             (cond

+             ;; Go to the beginning of the current word, and check if we are

              ;; directly on 'begin'
              ;; 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)
              ;; on first line of task declaration
              ((save-excursion
                 (and (ada-goto-stmt-start)


@@ -3892,14 +4407,21 @@ Moves to 'begin' if in a declarative part."
               (ada-goto-matching-end 0))
              ;; package start
              ((save-excursion
               (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))
               (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
              ;; 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)))
              ;; (hopefully ;-) everything else
              (t
               (ada-goto-matching-end 1)))


@@ -3907,8 +4429,7 @@ Moves to 'begin' if in a declarative part."
             )
 
           ;; now really move to the position found
             )
 
           ;; 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))))
 
       ;; restore syntax-table
       (set-syntax-table previous-syntax-table))))


@@ -3918,7 +4439,7 @@ Moves to 'begin' if in a declarative part."
   (interactive)
   (end-of-line)
   (if (re-search-forward ada-procedure-start-regexp nil t)
   (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 ()
     (error "No more functions/procedures/tasks")))
 
 (defun ada-previous-procedure ()


@@ -3926,7 +4447,7 @@ Moves to 'begin' if in a declarative part."
   (interactive)
   (beginning-of-line)
   (if (re-search-backward ada-procedure-start-regexp nil t)
   (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 ()
     (error "No more functions/procedures/tasks")))
 
 (defun ada-next-package ()


@@ -3959,7 +4480,9 @@ Moves to 'begin' if in a declarative part."
   (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 "\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-f" 'ada-format-paramlist)
   ;; We don't want to make meta-characters case-specific.
 


@@ -3977,6 +4500,7 @@ Moves to 'begin' if in a declarative part."
   (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-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
 
   ;; On XEmacs, you can easily specify whether DEL should deletes
   ;; one character forward or one character backward. Take this into


@@ -3991,78 +4515,227 @@ Moves to 'begin' if in a declarative part."
   ;; 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)
   ;; 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 ()
   )
 
 
 (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-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
 ;; -------------------------------------------------------
 
 \f
 ;; -------------------------------------------------------


@@ -4076,9 +4749,10 @@ can add its own items."
 ;;  function for justifying the comments.
 ;; -------------------------------------------------------
 
 ;;  function for justifying the comments.
 ;; -------------------------------------------------------
 

-(defadvice comment-region (before ada-uncomment-anywhere)
+(defadvice comment-region (before ada-uncomment-anywhere disable)

   (if (and arg
   (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))))
            (string= mode-name "Ada"))
       (save-excursion
         (let ((cs (concat "^[ \t]*" (regexp-quote comment-start))))


@@ -4093,12 +4767,13 @@ can add its own items."
 
   ;;  This advice is not needed anymore with Emacs21. However, for older
   ;;  versions, as well as for XEmacs, we still need to enable it.
 
   ;;  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)
       (progn
        (ad-activate 'comment-region)

-       (comment-region beg end (- (or arg 1)))
+       (comment-region beg end (- (or arg 2)))

        (ad-deactivate 'comment-region))
        (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."
 
 (defun ada-fill-comment-paragraph-justify ()
   "Fills current comment paragraph and justifies each line as well."


@@ -4124,10 +4799,8 @@ The paragraph is indented on the first line."
            (not (looking-at "[ \t]*--")))
       (error "not inside comment"))
 
            (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
 
          ;; Sets this variable to nil, otherwise it prevents
          ;; fill-region-as-paragraph to work on Emacs <= 20.2


@@ -4138,12 +4811,12 @@ The paragraph is indented on the first line."
 
     ;;  Find end of paragraph
     (back-to-indentation)
 
     ;;  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.
       (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)
          (insert "\n")
        (back-to-indentation)))
     (beginning-of-line)


@@ -4151,13 +4824,16 @@ The paragraph is indented on the first line."
     (goto-char opos)
 
     ;;  Find beginning of paragraph
     (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))
       (forward-line 1))

+    (beginning-of-line)

     (setq from (point-marker))
 
     ;;  Calculate the indentation we will need for the paragraph
     (setq from (point-marker))
 
     ;;  Calculate the indentation we will need for the paragraph


@@ -4171,13 +4847,6 @@ The paragraph is indented on the first line."
     (while (re-search-forward "--\n" to t)
       (replace-match "\n"))
 
     (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))
 
     (goto-char (1- to))
     (setq to (point-marker))
 


@@ -4203,7 +4872,7 @@ The paragraph is indented on the first line."
 
     ;;  In Emacs <= 20.2 and XEmacs <=20.4, there is a bug, and a newline is
     ;;  inserted at the end. Delete it
 
     ;;  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)))
             (<= emacs-major-version 19)
             (and (= emacs-major-version 20)
                  (<= emacs-minor-version 2)))


@@ -4278,8 +4947,20 @@ otherwise."
       (setq is-spec name)
 
       (while suffixes
       (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)))
        (setq suffixes (cdr suffixes)))
 
       is-spec)))


@@ -4307,15 +4988,13 @@ Redefines the function `ff-which-function-are-we-in'."
 (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
 (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."
 
 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
         (pos (point))
         end-pos

-        func-name
+        func-name indent

         found)
 
     ;;  If this is the same line as before, simply return the same result
         found)
 
     ;;  If this is the same line as before, simply return the same result


@@ -4325,28 +5004,46 @@ Since the search can be long, the results are cached."
       (save-excursion
         ;; In case the current line is also the beginning of the body
         (end-of-line)
       (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.
 
         ;; 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))
 
         (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
           (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
                 (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)
                     (setq end-pos (point))
                   (setq end-pos (point-max)))
                 (if (>= end-pos pos)


@@ -4380,9 +5077,21 @@ Returns nil if no body was found."
 
   (unless spec-name (setq spec-name (buffer-file-name)))
 
 
   (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 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)))
                         (ada-make-filename-from-adaname
                          (file-name-nondirectory
                           (file-name-sans-extension spec-name)))


@@ -4413,7 +5122,7 @@ Returns nil if no body was found."
   ;; a string
   ;; This sets the properties of the characters, so that ada-in-string-p
   ;; correctly handles '"' too...
   ;; 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)))
     ))
 
     ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))
     ))
 


@@ -4451,7 +5160,7 @@ Returns nil if no body was found."
      ;;
      ;; Optional keywords followed by a type name.
      (list (concat                      ; ":[ \t]*"
      ;;
      ;; 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))
             "[ \t]*"
             "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
            '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))


@@ -4467,7 +5176,7 @@ Returns nil if no body was found."
                 "null" "or" "others" "private" "protected" "raise"
                 "range" "record" "rem" "renames" "requeue" "return" "reverse"
                 "select" "separate" "tagged" "task" "terminate" "then" "until"
                 "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.
              "\\>")
      ;;
      ;; Anything following end and not already fontified is a body name.


@@ -4484,12 +5193,22 @@ Returns nil if no body was found."
                  font-lock-type-face) nil t))
      ;;
      ;; Keywords followed by a (comma separated list of) reference.
                  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))
            '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))

+

      ;;
      ;; Goto tags.
      '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face)
      ;;
      ;; 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.")
 
      ))
   "Default expressions to highlight in Ada mode.")
 


@@ -4506,6 +5225,33 @@ Returns nil if no body was found."
       (back-to-indentation)
       (current-column))))
 
       (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
 ;; ---------------------------------------------------------
 ;;    Automatic generation of code
 ;; The Ada-mode has a set of function to automatically generate a subprogram


@@ -4640,7 +5386,7 @@ This function typically is to be hooked into `ff-file-created-hooks'."
           (setq body-file (ada-get-body-name))
           (if body-file
               (find-file body-file)
           (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)
 
           (save-restriction
             (widen)


@@ -4679,17 +5425,68 @@ This function typically is to be hooked into `ff-file-created-hooks'."
 ;;  Read the special cases for exceptions
 (ada-case-read-exceptions)
 
 ;;  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
 (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)
 
 
 ;;; provide ourselves
 (provide 'ada-mode)
 

+;;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270

 ;;; ada-mode.el ends here
 ;;; ada-mode.el ends here