X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3ca7b46f5346984efb9e753f180b5f907452fd1f..1aaf8a45eea127b3213868db2d2cbb75e5c0e4b0:/lisp/progmodes/ada-mode.el

diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 699f2f2f7f..f7688e2406 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -1,10 +1,16 @@
-;;; ada-mode.el - An Emacs major-mode for editing Ada source.
-;;; Copyright (C) 1994 Free Software Foundation, Inc.
+;;; ada-mode.el --- major-mode for editing Ada sources
 
-;;; Authors: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
-;;;          Rolf Ebert      <ebert@inf.enst.fr>
+;; Copyright (C) 1994, 95, 97, 98, 99, 2000, 2001, 2002, 03, 2004
+;;  Free Software Foundation, Inc.
 
-;;; This file is part of GNU Emacs.
+;; 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.188
+;; Keywords: languages ada
+
+;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -17,25 +23,41 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; This mode is a complete rewrite of a major mode for editing Ada 83
-;;; and Ada 94 source code under Emacs-19.  It contains completely new
-;;; indenting code and support for code browsing (see ada-xref).
-
-
-;;; USAGE
-;;; =====
-;;; Emacs should enter ada-mode when you load an ada source (*.ada).
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; 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 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
+;;; features provided only by Gnat.
 ;;;
-;;; When you have entered ada-mode, you may get more info by pressing
-;;; C-h m. You may also get online help describing various functions by:
-;;; C-h d <Name of function you want described>
-
+;;; Note: this mode will not work with Emacs 19. If you are on a VMS
+;;; system, where the latest version of Emacs is 19.28, you will need
+;;; another file, called ada-vms.el, that provides some required
+;;; functions.
+
+;;; Usage:
+;;; Emacs should enter Ada mode automatically when you load an Ada file.
+;;; By default, the valid extensions for Ada files are .ads, .adb or .ada
+;;; If the ada-mode does not start automatically, then simply type the
+;;; following command :
+;;;     M-x ada-mode
+;;;
+;;; By default, ada-mode is configured to take full advantage of the GNAT
+;;; compiler (the menus will include the cross-referencing features,...).
+;;; If you are using another compiler, you might want to set the following
+;;; variable in your .emacs (Note: do not set this in the ada-mode-hook, it
+;;; won't work) :
+;;;    (setq ada-which-compiler 'generic)
+;;;
+;;; This mode requires find-file.el to be present on your system.
 
-;;; HISTORY
-;;; =======
+;;; History:
 ;;; The first Ada mode for GNU Emacs was written by V. Broman in
 ;;; 1985. He based his work on the already existing Modula-2 mode.
 ;;; This was distributed as ada.el in versions of Emacs prior to 19.29.
@@ -50,277 +72,761 @@
 ;;; Gosling Emacs. L. Slater based his development on ada.el and
 ;;; electric-ada.el.
 ;;;
-;;; The current Ada mode is a complete rewrite by M. Heritsch and
-;;; R. Ebert.  Some ideas from the ada-mode mailing list have been
+;;; A complete rewrite by M. Heritsch and R. Ebert has been done.
+;;; Some ideas from the Ada mode mailing list have been
 ;;; added.  Some of the functionality of L. Slater's mode has not
 ;;; (yet) been recoded in this new mode.  Perhaps you prefer sticking
 ;;; to his version.
-
-
-;;; KNOWN BUGS / BUGREPORTS
-;;; =======================
-;;;
-;;; In the presence of comments and/or incorrect syntax
-;;; ada-format-paramlist produces weird results.
-;;;
-;;; Indentation is sometimes wrong at the very beginning of the buffer.
-;;; So please try it on different locations. If it's still wrong then
-;;; report the bug.
-;;;
-;;; At the moment the browsing functions are limited to the use of the
-;;; separate packages "find-file.el" and "ada-xref.el" (ada-xref.el is
-;;; only for GNAT users).
 ;;;
-;;; indenting of some tasking constructs is not yet supported.
-;;;
-;;; `reformat-region' sometimes generates some weird indentation.
-;;;
-;;;> I have the following suggestions for the function template: 1) I
-;;;> don't want it automatically assigning it a name for the return variable. I
-;;;> never want it to be called "Result" because that is nondescriptive. If you
-;;;> must define a variable, give me the ability to specify its name.
-;;;>
-;;;> 2) You do not provide a type for variable 'Result'. Its type is the same
-;;;> as the function's return type, which the template knows, so why force me
-;;;> to type it in?
-;;;>
-
-;;;As always, different users have different tastes.
-;;;It would be nice if one could configure such layout details separately
-;;;without patching the LISP code. Maybe the metalanguage used in ada-stmt.el
-;;;could be taken even further, providing the user with some nice syntax
-;;;for describing layout. Then my own hacks would survive the next
-;;;update of the package :-)
-
-;;;By the way, there are some more quirks:
-
-;;;1) text entered in prompt mode (*) is not converted to upper case (I have
-;;;   choosen upper case for indentifiers).
-;;;   (*) I would like to suggest the term "template code" instead of
-;;;   "pseudo code".
-
-;;; There are quite a few problems in the crossreferencing part. These
-;;; are partly due to errors in gnatf.  One of the major bugs in
-;;; ada-xref is, that we do not wait for gnatf to rebuild the xref file.
-;;; We start the job, but do not wait for finishing.
-
-
-;;; LCD Archive Entry:
-;;; ada-mode|Rolf Ebert|<ebert@inf.enst.fr>
-;;; |Major-mode for Ada
-;;; |$Date: 1995/03/02 11:07:44 $|$Revision: 1.3 $|
-
-
-(defconst ada-mode-version (substring "$Revision: 1.3 $" 11 -2)
-  "$Id: ada-mode.el,v 1.3 1995/03/02 11:07:44 simon Exp kwzh $
-
-Report bugs to: Rolf Ebert <ebert@inf.enst.fr>")
-
-
-;;;--------------------
-;;;    USER OPTIONS
-;;;--------------------
-
-;; ---- configure indentation
-
-(defvar ada-indent 3
-  "*Defines the size of Ada indentation.")
-
-(defvar ada-broken-indent 2
-  "*# of columns to indent the continuation of a broken line.")
-
-(defvar ada-label-indent -4
-  "*# of columns to indent a label.")
-
-(defvar ada-stmt-end-indent 0
-  "*# of columns to indent a statement end keyword in a separate line.
-Examples are 'is', 'loop', 'record', ...")
-
-(defvar ada-when-indent 3
-  "*Defines the indentation for 'when' relative to 'exception' or 'case'.")
-
-(defvar ada-indent-record-rel-type 3
-  "*Defines the indentation for 'record' relative to 'type' or 'use'.")
-
-(defvar ada-indent-comment-as-code t
-  "*If non-nil, comment-lines get indented as ada-code.")
-
-(defvar ada-indent-is-separate t
-  "*If non-nil, 'is separate' or 'is abstract' on a separate line are
-indented.")
-
-(defvar ada-indent-to-open-paren t
-  "*If non-nil, following lines get indented according to the innermost
-open parenthesis.")
-
-(defvar ada-search-paren-line-count-limit 5
-  "*Search that many non-blank non-comment lines for an open parenthesis.
-Values higher than about 5 horribly slow down the indenting.")
-
-
-;; ---- other user options
-
-(defvar ada-tab-policy 'indent-auto
-  "*Control behaviour of the TAB key.
-Must be one of 'indent-rigidly, 'indent-auto, 'gei, 'indent-af or 'always-tab.
-
-'indent-rigidly : always adds ada-indent blanks at the beginning of the line.
-'indent-auto    : use indentation functions in this file.
-'gei            : use David K}gedal's Generic Indentation Engine.
-'indent-af      : use Gary E. Barnes' ada-format.el
-'always-tab     : do indent-relative.")
-
-(defvar ada-move-to-declaration nil
-  "*If non-nil, ada-move-to-start moves point to the subprog-declaration,
-not to 'begin'.")
-
-(defvar ada-spec-suffix ".ads"
-  "*Suffix of Ada specification files.")
-
-(defvar ada-body-suffix ".adb"
-  "*Suffix of Ada body files.")
-
-(defvar ada-language-version 'ada94
-  "*Do we program in 'ada83 or 'ada94?")
-
-(defvar ada-case-keyword 'downcase-word
-  "*downcase-word, upcase-word, ada-loose-case-word or capitalize-word
-to adjust ada keywords case.")
-
-(defvar ada-case-identifier 'ada-loose-case-word
-  "*downcase-word, upcase-word, ada-loose-case-word or capitalize-word
-to adjust ada identifier case.")
-
-(defvar ada-auto-case t
-  "*Non-nil automatically changes casing of preceeding word while typing.
-Casing is done according to ada-case-keyword and ada-case-identifier.")
-
-(defvar ada-clean-buffer-before-saving  nil
-  "*If non-nil, remove-trailing-spaces and untabify buffer before saving.")
+;;; A complete rewrite for Emacs-20 / Gnat-3.11 has been done by Ada Core
+;;; Technologies. Please send bugs to  briot@gnat.com
+
+;;; Credits:
+;;;   Many thanks to John McCabe <john@assen.demon.co.uk> for sending so
+;;;     many patches included in this package.
+;;;   Christian Egli <Christian.Egli@hcsd.hac.com>:
+;;;     ada-imenu-generic-expression
+;;;   Many thanks also to the following persons that have contributed one day
+;;;   to the ada-mode
+;;;     Philippe Waroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular,
+;;;     woodruff@stc.llnl.gov (John Woodruff)
+;;;     jj@ddci.dk (Jesper Joergensen)
+;;;     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:
+;;; Note: Every function in this package is compiler-independent.
+;;; The names start with  ada-
+;;; The variables that the user can edit can all be modified through
+;;;   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
+  (defun ada-check-emacs-version (major minor &optional is-xemacs)
+    "Returns t if Emacs's version is greater or equal to MAJOR.MINOR.
+If IS-XEMACS is non-nil, check for XEmacs instead of Emacs."
+    (let ((xemacs-running (or (string-match "Lucid"  emacs-version)
+                              (string-match "XEmacs" emacs-version))))
+      (and (or (and is-xemacs xemacs-running)
+               (not (or is-xemacs xemacs-running)))
+           (or (> emacs-major-version major)
+               (and (= emacs-major-version major)
+                    (>= emacs-minor-version minor)))))))
+
+
+;;  This call should not be made in the release that is done for the
+;;  official Emacs, since it does nothing useful for the latest version
+;;(if (not (ada-check-emacs-version 21 1))
+;;    (require 'ada-support))
 
 (defvar ada-mode-hook nil
-  "*List of functions to call when Ada Mode is invoked.
+  "*List of functions to call when Ada mode is invoked.
+This hook is automatically executed after the `ada-mode' is
+fully loaded.
 This is a good place to add Ada environment specific bindings.")
 
-(defvar ada-external-pretty-print-program "aimap"
-  "*External pretty printer to call from within Ada Mode.")
+(defgroup ada nil
+  "Major mode for editing Ada source in Emacs."
+  :group 'languages)
+
+(defcustom ada-auto-case t
+  "*Non-nil means automatically change case of preceding word while typing.
+Casing is done according to `ada-case-keyword', `ada-case-identifier'
+and `ada-case-attribute'."
+  :type 'boolean :group 'ada)
+
+(defcustom ada-broken-decl-indent 0
+  "*Number of columns to indent a broken declaration.
+
+An example is :
+  declare
+     A,
+     >>>>>B : Integer;  --  from ada-broken-decl-indent"
+  :type 'integer :group 'ada)
+
+(defcustom ada-broken-indent 2
+  "*Number of columns to indent the continuation of a broken line.
+
+An example is :
+   My_Var : My_Type := (Field1 =>
+                        >>>>>>>>>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',
+`ada-capitalize-word' or `ada-no-auto-case'."
+  :type '(choice (const downcase-word)
+                 (const upcase-word)
+                 (const ada-capitalize-word)
+                 (const ada-loose-case-word)
+                 (const ada-no-auto-case))
+  :group 'ada)
+
+(defcustom ada-case-exception-file
+  (list (convert-standard-filename' "~/.emacs_case_exceptions"))
+  "*List of special casing exceptions dictionaries for identifiers.
+The first file is the one where new exceptions will be saved by Emacs
+when you call `ada-create-case-exception'.
+
+These files should contain one word per line, that gives the casing
+to be used for that word in Ada files. 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)
+
+(defcustom ada-case-keyword 'downcase-word
+  "*Function to call to adjust the case of an Ada keywords.
+It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
+`ada-capitalize-word'."
+  :type '(choice (const downcase-word)
+                 (const upcase-word)
+                 (const ada-capitalize-word)
+                 (const ada-loose-case-word)
+                 (const ada-no-auto-case))
+  :group 'ada)
+
+(defcustom ada-case-identifier 'ada-loose-case-word
+  "*Function to call to adjust the case of an Ada identifier.
+It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
+`ada-capitalize-word'."
+  :type '(choice (const downcase-word)
+                 (const upcase-word)
+                 (const ada-capitalize-word)
+                 (const ada-loose-case-word)
+                 (const ada-no-auto-case))
+  :group 'ada)
+
+(defcustom ada-clean-buffer-before-saving t
+  "*Non-nil means remove trailing spaces and untabify the buffer before saving."
+  :type 'boolean :group 'ada)
+
+(defcustom ada-indent 3
+  "*Size of Ada indentation.
+
+An example is :
+procedure Foo is
+begin
+>>>>>>>>>>null;  --  from ada-indent"
+  :type 'integer  :group 'ada)
+
+(defcustom ada-indent-after-return t
+  "*Non-nil means automatically indent after RET or LFD."
+  :type 'boolean :group 'ada)
+
+(defcustom ada-indent-align-comments t
+  "*Non-nil means align comments on previous line comments, if any.
+If nil, indentation is calculated as usual.
+Note that indentation is calculated only if `ada-indent-comment-as-code' is t.
+
+For instance:
+    A := 1;   --  A multi-line comment
+              --  aligned if ada-indent-align-comments is t"
+  :type 'boolean :group 'ada)
+
+(defcustom ada-indent-comment-as-code t
+  "*Non-nil means indent comment lines as code.
+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-record-rel-type 3
+  "*Indentation for 'record' relative to 'type' or 'use'.
+
+An example is:
+   type A is
+   >>>>>>>>>>>record    --  from ada-indent-record-rel-type"
+  :type 'integer :group 'ada)
+
+(defcustom ada-indent-renames ada-broken-indent
+  "*Indentation for renames relative to the matching function statement.
+If ada-indent-return is null or negative, the indentation is done relative to
+the open parenthesis (if there is no parenthesis, ada-broken-indent is used).
+
+An example is:
+   function A (B : Integer)
+       return C;      --  from ada-indent-return
+   >>>renames Foo;    --  from ada-indent-renames"
+  :type 'integer :group 'ada)
+
+(defcustom ada-indent-return 0
+  "*Indentation for 'return' relative to the matching 'function' statement.
+If ada-indent-return is null or negative, the indentation is done relative to
+the open parenthesis (if there is no parenthesis, ada-broken-indent is used).
+
+An example is:
+   function A (B : Integer)
+   >>>>>return C;       --  from ada-indent-return"
+  :type 'integer :group 'ada)
+
+(defcustom ada-indent-to-open-paren t
+  "*Non-nil means indent according to the innermost open parenthesis."
+  :type 'boolean :group 'ada)
+
+(defcustom ada-fill-comment-prefix "--  "
+  "*Text inserted in the first columns when filling a comment paragraph.
+Note: if you modify this variable, you will have to invoke `ada-mode'
+again to take account of the new value."
+  :type 'string :group 'ada)
+
+(defcustom ada-fill-comment-postfix " --"
+  "*Text inserted at the end of each line when filling a comment paragraph.
+with `ada-fill-comment-paragraph-postfix'."
+  :type 'string :group 'ada)
+
+(defcustom ada-label-indent -4
+  "*Number of columns to indent a label.
+
+An example is:
+procedure Foo is
+begin
+>>>>>>>>>>>>Label:  --  from ada-label-indent
+
+This is also used for <<..>> labels"
+  :type 'integer :group 'ada)
+
+(defcustom ada-language-version 'ada95
+  "*Do we program in `ada83' or `ada95'?"
+  :type '(choice (const ada83) (const ada95)) :group 'ada)
+
+(defcustom ada-move-to-declaration nil
+  "*Non-nil means `ada-move-to-start' moves point to the subprogram declaration,
+not to 'begin'."
+  :type 'boolean :group 'ada)
+
+(defcustom ada-popup-key '[down-mouse-3]
+  "*Key used for binding the contextual menu.
+If nil, no contextual menu is available."
+  :type '(restricted-sexp :match-alternatives (stringp vectorp))
+  :group 'ada)
+
+(defcustom ada-search-directories
+  (append '(".")
+	  (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
+	  '("/usr/adainclude" "/usr/local/adainclude"
+	    "/opt/gnu/adainclude"))
+  "*List of directories to search for Ada files.
+See the description for the `ff-search-directories' variable. This variable
+is the initial value of this variable, and is copied and modified in
+`ada-search-directories-internal'."
+  :type '(repeat (choice :tag "Directory"
+                         (const :tag "default" nil)
+                         (directory :format "%v")))
+  :group 'ada)
+
+(defvar ada-search-directories-internal ada-search-directories
+  "Internal version of `ada-search-directories'.
+Its value is the concatenation of the search path as read in the project file
+and the standard runtime location, and the value of the user-defined
+ada-search-directories.")
+
+(defcustom ada-stmt-end-indent 0
+  "*Number of columns to indent the end of a statement on a separate line.
+
+An example is:
+   if A = B
+   >>>>>>>>>>>then   --  from ada-stmt-end-indent"
+  :type 'integer :group 'ada)
+
+(defcustom ada-tab-policy 'indent-auto
+  "*Control the behavior of the TAB key.
+Must be one of :
+`indent-rigidly' : always adds ada-indent blanks at the beginning of the line.
+`indent-auto'    : use indentation functions in this file.
+`always-tab'     : do indent-relative."
+  :type '(choice (const indent-auto)
+                 (const indent-rigidly)
+                 (const always-tab))
+  :group 'ada)
+
+(defcustom ada-use-indent ada-broken-indent
+  "*Indentation for the lines in a 'use' statement.
+
+An example is:
+   use Ada.Text_IO,
+   >>>>>Ada.Numerics;    --  from ada-use-indent"
+  :type 'integer :group 'ada)
+
+(defcustom ada-when-indent 3
+  "*Indentation for 'when' relative to 'exception' or 'case'.
+
+An example is:
+   case A is
+   >>>>>>>>when B =>     --  from ada-when-indent"
+  :type 'integer :group 'ada)
+
+(defcustom ada-with-indent ada-broken-indent
+  "*Indentation for the lines in a 'with' statement.
+
+An example is:
+   with Ada.Text_IO,
+   >>>>>Ada.Numerics;    --  from ada-with-indent"
+  :type 'integer :group 'ada)
+
+(defcustom ada-which-compiler 'gnat
+  "*Name of the compiler to use.
+This will determine what features are made available through the ada-mode.
+The possible choices are :
+`gnat': Use Ada Core Technologies' Gnat compiler. Add some cross-referencing
+    features
+`generic': Use a generic compiler"
+  :type '(choice (const gnat)
+                 (const generic))
+  :group 'ada)
 
-(defvar ada-tmp-directory "/tmp/"
-  "*Directory to store the temporary file for the Ada pretty printer.")
 
-(defvar ada-fill-comment-prefix "-- "
-  "*This is inserted in the first columns when filling a comment paragraph.")
+;;; ---- end of user configurable variables
+
+
+(defvar ada-body-suffixes '(".adb")
+  "List of possible suffixes for Ada body files.
+The extensions should include a `.' if needed.")
 
-(defvar ada-fill-comment-postfix " --"
-  "*This is inserted at the end of each line when filling a comment paragraph
-with ada-fill-comment-paragraph postfix.")
+(defvar ada-spec-suffixes '(".ads")
+  "List of possible suffixes for Ada spec files.
+The extensions should include a `.' if needed.")
 
-(defvar ada-krunch-args "250"
-  "*Argument of gnatk8, a string containing the max number of characters.
-Set to a big number, if you dont use crunched filenames.")
+(defvar ada-mode-menu (make-sparse-keymap "Ada")
+  "Menu for ada-mode.")
 
-;;; ---- end of user configurable variables
-
+(defvar ada-mode-map (make-sparse-keymap)
+  "Local keymap used for Ada mode.")
 
 (defvar ada-mode-abbrev-table nil
-  "Abbrev table used in Ada mode.")
-(define-abbrev-table 'ada-mode-abbrev-table ())
-
-(defvar ada-mode-map ()
-  "Local keymap used for ada-mode.")
+  "Local abbrev table for Ada mode.")
 
 (defvar ada-mode-syntax-table nil
   "Syntax table to be used for editing Ada source code.")
 
-(defconst ada-83-keywords
-  "\\<\\(abort\\|abs\\|accept\\|access\\|all\\|and\\|array\\|\
-at\\|begin\\|body\\|case\\|constant\\|declare\\|delay\\|delta\\|\
-digits\\|do\\|else\\|elsif\\|end\\|entry\\|exception\\|exit\\|for\\|\
-function\\|generic\\|goto\\|if\\|in\\|is\\|limited\\|loop\\|mod\\|\
-new\\|not\\|null\\|of\\|or\\|others\\|out\\|package\\|pragma\\|\
-private\\|procedure\\|raise\\|range\\|record\\|rem\\|renames\\|\
-return\\|reverse\\|select\\|separate\\|subtype\\|task\\|terminate\\|\
-then\\|type\\|use\\|when\\|while\\|with\\|xor\\)\\>"
-  "regular expression for looking at Ada83 keywords.")
-
-(defconst ada-94-keywords
-  "\\<\\(abort\\|abs\\|abstract\\|accept\\|access\\|aliased\\|\
-all\\|and\\|array\\|at\\|begin\\|body\\|case\\|constant\\|declare\\|\
-delay\\|delta\\|digits\\|do\\|else\\|elsif\\|end\\|entry\\|\
-exception\\|exit\\|for\\|function\\|generic\\|goto\\|if\\|in\\|\
-is\\|limited\\|loop\\|mod\\|new\\|not\\|null\\|of\\|or\\|others\\|\
-out\\|package\\|pragma\\|private\\|procedure\\|protected\\|raise\\|\
-range\\|record\\|rem\\|renames\\|requeue\\|return\\|reverse\\|\
-select\\|separate\\|subtype\\|tagged\\|task\\|terminate\\|then\\|\
-type\\|until\\|use\\|when\\|while\\|with\\|xor\\)\\>"
-  "regular expression for looking at Ad94 keywords.")
-
-(defvar ada-keywords ada-94-keywords
-  "regular expression for looking at Ada keywords.")
+(defvar ada-mode-symbol-syntax-table nil
+  "Syntax table for Ada, where `_' is a word constituent.")
+
+(eval-when-compile
+  (defconst ada-83-string-keywords
+    '("abort" "abs" "accept" "access" "all" "and" "array" "at" "begin"
+      "body" "case" "constant" "declare" "delay" "delta" "digits" "do"
+      "else" "elsif" "end" "entry" "exception" "exit" "for" "function"
+      "generic" "goto" "if" "in" "is" "limited" "loop" "mod" "new"
+      "not" "null" "of" "or" "others" "out" "package" "pragma" "private"
+      "procedure" "raise" "range" "record" "rem" "renames" "return"
+      "reverse" "select" "separate" "subtype" "task" "terminate" "then"
+      "type" "use" "when" "while" "with" "xor")
+    "List of Ada keywords.
+This variable is used to define `ada-83-keywords' and `ada-95-keywords'"))
 
 (defvar ada-ret-binding nil
   "Variable to save key binding of RET when casing is activated.")
 
+(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.")
 
-;;; ---- Regexps to find procedures/functions/packages
+(defvar ada-other-file-alist nil
+  "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
+  (eval-when-compile
+    (concat "\\<" (regexp-opt ada-83-string-keywords t) "\\>"))
+  "Regular expression for looking at Ada83 keywords.")
+
+(defconst ada-95-keywords
+  (eval-when-compile
+    (concat "\\<" (regexp-opt
+                   (append
+                    '("abstract" "aliased" "protected" "requeue"
+                      "tagged" "until")
+                    ada-83-string-keywords) t) "\\>"))
+  "Regular expression for looking at Ada95 keywords.")
+
+(defvar ada-keywords ada-95-keywords
+  "Regular expression for looking at Ada keywords.")
+
+(defconst ada-ident-re
+  "\\(\\sw\\|[_.]\\)+"
+  "Regexp matching Ada (qualified) identifiers.")
+
+;;  "with" needs to be included in the regexp, so that we can insert new lines
+;;  after the declaration of the parameter for a generic.
 (defvar ada-procedure-start-regexp
-  "^[ \t]*\\(procedure\\|function\\|task\\)[ \t\n]+\\([a-zA-Z0-9_\\.]+\\)"
+  (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
   "^[ \t]*\\(package\\)"
-  "Regexp used to find Ada packages")
+  "Regexp used to find Ada packages.")
 
 
 ;;; ---- regexps for indentation functions
 
 (defvar ada-block-start-re
-  "\\<\\(begin\\|select\\|declare\\|private\\|or\\|generic\\|\
-exception\\|loop\\|record\\|else\\)\\>"
-  "Regexp for keywords starting ada-blocks.")
+  (eval-when-compile
+    (concat "\\<\\(" (regexp-opt '("begin" "declare" "else"
+                                   "exception" "generic" "loop" "or"
+                                   "private" "select" ))
+            "\\|\\(\\(limited\\|abstract\\|tagged\\)[ \t\n]+\\)*record\\)\\>"))
+  "Regexp for keywords starting Ada blocks.")
 
 (defvar ada-end-stmt-re
-  "\\(;\\|=>\\|\\<\\(begin\\|record\\|loop\\|select\\|do\\|\
-exception\\|declare\\|generic\\|private\\)\\>\\)"
+  (eval-when-compile
+    (concat "\\("
+            ";"                                        "\\|"
+            "=>[ \t]*$"                                "\\|"
+            "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)"  "\\|"
+            "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
+                                "loop" "private" "record" "select"
+                                "then abort" "then") t) "\\>"  "\\|"
+            "^[ \t]*" (regexp-opt '("function" "package" "procedure")
+                                  t) "\\>\\(\\sw\\|[ \t_.]\\)+\\<is\\>"        "\\|"
+            "^[ \t]*exception\\>"
+            "\\)")                      )
   "Regexp of possible ends for a non-broken statement.
-'end' means that there has to start a new statement after these.")
+A new statement starts after these.")
+
+(defvar ada-matching-start-re
+  (eval-when-compile
+    (concat "\\<"
+            (regexp-opt
+             '("end" "loop" "select" "begin" "case" "do"
+               "if" "task" "package" "record" "protected") t)
+            "\\>"))
+  "Regexp used in ada-goto-matching-start.")
+
+(defvar ada-matching-decl-start-re
+  (eval-when-compile
+    (concat "\\<"
+            (regexp-opt
+             '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
+            "\\>"))
+  "Regexp used in ada-goto-matching-decl-start.")
 
 (defvar ada-loop-start-re
   "\\<\\(for\\|while\\|loop\\)\\>"
   "Regexp for the start of a loop.")
 
 (defvar ada-subprog-start-re
-  "\\<\\(procedure\\|function\\|task\\|accept\\)\\>"
+  (eval-when-compile
+    (concat "\\<" (regexp-opt '("accept" "entry" "function" "package" "procedure"
+                                "protected" "task") t) "\\>"))
   "Regexp for the start of a subprogram.")
 
+(defvar ada-named-block-re
+  "[ \t]*\\(\\sw\\|_\\)+[ \t]*:[^=]"
+  "Regexp of the name of a block or loop.")
+
+(defvar ada-contextual-menu-on-identifier nil
+  "Set to true when the right mouse button was clicked on an identifier.")
+
+(defvar ada-contextual-menu-last-point nil
+  "Position of point just before displaying the menu.
+This is a list (point buffer).
+Since `ada-popup-menu' moves the point where the user clicked, the region
+is modified. Therefore no command from the menu knows what the user selected
+before displaying the contextual menu.
+To get the original region, restore the point to this position before
+calling `region-end' and `region-beginning'.
+Modify this variable if you want to restore the point to another position.")
+
+(easy-menu-define ada-contextual-menu nil
+  "Menu to use when the user presses the right mouse button.
+The variable `ada-contextual-menu-on-identifier' will be set to t before
+displaying the menu if point was on an identifier."
+  '("Ada"
+    ["Goto Declaration/Body" ada-point-and-xref
+     :included ada-contextual-menu-on-identifier]
+    ["Goto Body" ada-point-and-xref-body
+     :included ada-contextual-menu-on-identifier]
+    ["Goto Previous Reference" ada-xref-goto-previous-reference]
+    ["List References" ada-find-references
+     :included ada-contextual-menu-on-identifier]
+    ["List Local References" ada-find-local-references
+      :included ada-contextual-menu-on-identifier]
+    ["-"                nil nil]
+    ["Other File"       ff-find-other-file]
+    ["Goto Parent Unit" ada-goto-parent]))
+
+
+;;------------------------------------------------------------------
+;; Support for imenu  (see imenu.el)
+;;------------------------------------------------------------------
+
+(defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?")
+
+(defconst ada-imenu-subprogram-menu-re
+  (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
+   (list nil ada-imenu-subprogram-menu-re 2)
+   (list "*Specs*"
+         (concat
+          "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)"
+          "\\("
+          "\\(" ada-imenu-comment-re "[ \t\n]+\\|[ \t\n]*([^)]+)"
+	  ada-imenu-comment-re "\\)";; parameter list or simple space
+          "\\([ \t\n]*return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?"
+          "\\)?;") 2)
+   '("*Tasks*" "^[ \t]*task[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
+   '("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2)
+   '("*Protected*"
+     "^[ \t]*protected[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
+   '("*Packages*" "^[ \t]*package[ \t]+\\(\\(body[ \t]+\\)?\\(\\sw\\|[_.]\\)+\\)" 1))
+  "Imenu generic expression for Ada mode.
+See `imenu-generic-expression'. This variable will create several submenus for
+each type of entity that can be found in an Ada file.")
+
+
+;;------------------------------------------------------------
+;;  Support for compile.el
+;;------------------------------------------------------------
+
+(defun ada-compile-mouse-goto-error ()
+  "Mouse interface for ada-compile-goto-error."
+  (interactive)
+  (mouse-set-point last-input-event)
+  (ada-compile-goto-error (point))
+  )
+
+(defun ada-compile-goto-error (pos)
+  "Replaces `compile-goto-error' from compile.el.
+If POS is on a file and line location, go to this position. It adds to
+compile.el the capacity to go to a reference in an error message.
+For instance, on this line:
+  foo.adb:61:11:  [...] in call to size declared at foo.ads:11
+both file locations can be clicked on and jumped to."
+  (interactive "d")
+  (goto-char pos)
+
+  (skip-chars-backward "-a-zA-Z0-9_:./\\")
+  (cond
+   ;;  special case: looking at a filename:line not at the beginning of a line
+   ((and (not (bolp))
+         (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
+          ;;  `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))))
+      (funcall (symbol-function 'compilation-goto-locus)
+               (cons source error-pos))
+      ))
+
+   ;; otherwise, default behavior
+   (t
+    (funcall (symbol-function 'compile-goto-error)))
+   )
+  (recenter))
+
 
-;;;-------------
-;;;  functions
-;;;-------------
+;;-------------------------------------------------------------------------
+;; Grammar related function
+;; The functions below work with the syntax class of the characters in an Ada
+;; buffer. Two syntax tables are created, depending on whether we want '_'
+;; to be considered as part of a word or not.
+;; Some characters may have multiple meanings depending on the context:
+;;  - ' is either the beginning of a constant character or an attribute
+;;  - # is either part of a based litteral or a gnatprep statement.
+;;  - " starts a string, but not if inside a constant character.
+;;  - ( and ) should be ignored if inside a constant character.
+;; Thus their syntax property is changed automatically, and we can still use
+;; the standard Emacs functions for sexp (see `ada-in-string-p')
+;;
+;; On Emacs, this is done through the `syntax-table' text property. The
+;; modification is done automatically each time the user as typed a new
+;; character. This is already done in `font-lock-mode' (in
+;; `font-lock-syntactic-keywords', so we take advantage of the existing
+;; mechanism. If font-lock-mode is not activated, we do it by hand in
+;; `ada-after-change-function', thanks to `ada-deactivate-properties' and
+;; `ada-initialize-properties'.
+;;
+;; on XEmacs, the `syntax-table' property does not exist and we have to use a
+;; slow advice to `parse-partial-sexp' to do the same thing.
+;; When executing parse-partial-sexp, we simply modify the strings before and
+;; after, so that the special constants '"', '(' and ')' do not interact
+;; with parse-partial-sexp.
+;; Note: this code is slow and needs to be rewritten as soon as something
+;; better is available on XEmacs.
+;;-------------------------------------------------------------------------
 
 (defun ada-create-syntax-table ()
-  "Create the syntax table for ada-mode."
-  ;; This syntax table is a merge of two syntax tables I found
-  ;; in the two ada modes in the old ada.el and the old
-  ;; electric-ada.el. (jsl)
-  ;; There still remains the problem, if the underscore '_' is a word
-  ;; constituent or not. (re)
-  ;; The Emacs doc clearly states that it is a symbol, and that is what most
-  ;; on the ada-mode list prefer. (re)
-  ;; For some functions, the syntactical meaning of '_' is temporaryly
-  ;; changed to 'w'. (mh)
+  "Create the two syntax tables use in the Ada mode.
+The standard table declares `_' as a symbol constituent, the second one
+declares it as a word constituent."
+  (interactive)
   (setq ada-mode-syntax-table (make-syntax-table))
   (set-syntax-table  ada-mode-syntax-table)
 
-  ;; define string brackets (% is alternative string bracket)
-  (modify-syntax-entry ?%  "\"" ada-mode-syntax-table)
+  ;; define string brackets (`%' is alternative string bracket, but
+  ;; almost never used as such and throws font-lock and indentation
+  ;; off the track.)
+  (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)
   (modify-syntax-entry ?\; "." ada-mode-syntax-table)
   (modify-syntax-entry ?&  "." ada-mode-syntax-table)
@@ -343,43 +849,245 @@ exception\\|declare\\|generic\\|private\\)\\>\\)"
   ;; a single hyphen is punctuation, but a double hyphen starts a comment
   (modify-syntax-entry ?-  ". 12" ada-mode-syntax-table)
 
+  ;; See the comment above on grammar related function for the special
+  ;; setup for '#'.
+  (if (featurep 'xemacs)
+      (modify-syntax-entry ?#  "<" ada-mode-syntax-table)
+    (modify-syntax-entry ?#  "$" ada-mode-syntax-table))
+
   ;; and \f and \n end a comment
   (modify-syntax-entry ?\f  ">   " ada-mode-syntax-table)
   (modify-syntax-entry ?\n  ">   " ada-mode-syntax-table)
 
-  ;; define what belongs in ada symbols
+  ;; define what belongs in Ada symbols
   (modify-syntax-entry ?_ "_" ada-mode-syntax-table)
 
   ;; define parentheses to match
   (modify-syntax-entry ?\( "()" ada-mode-syntax-table)
   (modify-syntax-entry ?\) ")(" ada-mode-syntax-table)
+
+  (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table))
+  (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table)
+  )
+
+;;  Support of special characters in XEmacs (see the comments at the beginning
+;;  of the section on Grammar related functions).
+
+(if (featurep 'xemacs)
+    (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants)
+      "Handles special character constants and gnatprep statements."
+      (let (change)
+        (if (< to from)
+            (let ((tmp from))
+              (setq from to  to tmp)))
+        (save-excursion
+          (goto-char from)
+          (while (re-search-forward "'\\([(\")#]\\)'" to t)
+            (setq change (cons (list (match-beginning 1)
+                                     1
+                                     (match-string 1))
+                               change))
+            (replace-match "'A'"))
+          (goto-char from)
+          (while (re-search-forward "\\(#[0-9a-fA-F]*#\\)" to t)
+            (setq change (cons (list (match-beginning 1)
+                                     (length (match-string 1))
+                                     (match-string 1))
+                               change))
+            (replace-match (make-string (length (match-string 1)) ?@))))
+        ad-do-it
+        (save-excursion
+          (while change
+            (goto-char (caar change))
+            (delete-char (cadar change))
+            (insert (caddar change))
+            (setq change (cdr change)))))))
+
+(defun ada-deactivate-properties ()
+  "Deactivate ada-mode's properties handling.
+This would be a duplicate of font-lock if both are used at the same time."
+  (remove-hook 'after-change-functions 'ada-after-change-function t))
+
+(defun ada-initialize-properties ()
+  "Initialize some special text properties in the whole buffer.
+In particular, character constants are said to be strings, #...# are treated
+as numbers instead of gnatprep comments."
+  (save-excursion
+    (save-restriction
+      (widen)
+      (goto-char (point-min))
+      (while (re-search-forward "'.'" nil t)
+        (add-text-properties (match-beginning 0) (match-end 0)
+                             '(syntax-table ("'" . ?\"))))
+      (goto-char (point-min))
+      (while (re-search-forward "^[ \t]*#" nil t)
+        (add-text-properties (match-beginning 0) (match-end 0)
+                             '(syntax-table (11 . 10))))
+      (set-buffer-modified-p nil)
+
+      ;;  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
+      (add-hook 'after-change-functions 'ada-after-change-function nil t)
+      )))
+
+(defun ada-after-change-function (beg end old-len)
+  "Called when the region between BEG and END was changed in the buffer.
+OLD-LEN indicates what the length of the replaced text was."
+  (let ((inhibit-point-motion-hooks t)
+        (eol (point)))
+    (save-excursion
+      (save-match-data
+        (beginning-of-line)
+        (remove-text-properties (point) eol '(syntax-table nil))
+        (while (re-search-forward "'.'" eol t)
+          (add-text-properties (match-beginning 0) (match-end 0)
+                               '(syntax-table ("'" . ?\"))))
+        (beginning-of-line)
+        (if (looking-at "^[ \t]*#")
+            (add-text-properties (match-beginning 0) (match-end 0)
+                                 '(syntax-table (11 . 10))))))))
+
+;;------------------------------------------------------------------
+;;  Testing the grammatical context
+;;------------------------------------------------------------------
+
+(defsubst ada-in-comment-p (&optional parse-result)
+  "Returns t if inside a comment."
+  (nth 4 (or parse-result
+             (parse-partial-sexp
+              (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
+              (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
+                          (line-beginning-position) (point))))
+  (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
+
+
+;;------------------------------------------------------------------
+;; Contextual menus
+;; The Ada-mode comes with contextual menus, bound by default to the right
+;; mouse button.
+;; Add items to this menu by modifying `ada-contextual-menu'. Note that the
+;; variable `ada-contextual-menu-on-identifier' is set automatically to t
+;; if the mouse button was pressed on an identifier.
+;;------------------------------------------------------------------
+
+(defun ada-call-from-contextual-menu (function)
+  "Execute FUNCTION when called from the contextual menu.
+It forces Emacs to change the cursor position."
+  (interactive)
+  (funcall function)
+  (setq ada-contextual-menu-last-point
+        (list (point) (current-buffer))))
+
+(defun ada-popup-menu (position)
+  "Pops up a contextual menu, depending on where the user clicked.
+POSITION is the location the mouse was clicked on.
+Sets `ada-contextual-menu-last-point' to the current position before
+displaying the menu. When a function from the menu is called, the point is
+where the mouse button was clicked."
+  (interactive "e")
+
+  ;;  declare this as a local variable, so that the function called
+  ;;  in the contextual menu does not hide the region in
+  ;;  transient-mark-mode.
+  (let ((deactivate-mark nil))
+    (setq ada-contextual-menu-last-point
+         (list (point) (current-buffer)))
+    (mouse-set-point last-input-event)
+
+    (setq ada-contextual-menu-on-identifier
+          (and (char-after)
+               (or (= (char-syntax (char-after)) ?w)
+                   (= (char-after) ?_))
+               (not (ada-in-string-or-comment-p))
+               (save-excursion (skip-syntax-forward "w")
+                               (not (ada-after-keyword-p)))
+               ))
+    (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))
+    ))
+
+
+;;------------------------------------------------------------------
+;; Misc functions
+;;------------------------------------------------------------------
+
+;;;###autoload
+(defun ada-add-extensions (spec body)
+  "Define SPEC and BODY as being valid extensions for Ada files.
+Going from body to spec with `ff-find-other-file' used these
+extensions.
+SPEC and BODY are two regular expressions that must match against the file
+name"
+  (let* ((reg (concat (regexp-quote body) "$"))
+         (tmp (assoc reg ada-other-file-alist)))
+    (if tmp
+        (setcdr tmp (list (cons spec (cadr tmp))))
+      (add-to-list 'ada-other-file-alist (list reg (list spec)))))
+
+  (let* ((reg (concat (regexp-quote spec) "$"))
+         (tmp (assoc reg ada-other-file-alist)))
+    (if tmp
+        (setcdr tmp (list (cons body (cadr tmp))))
+      (add-to-list 'ada-other-file-alist (list reg (list body)))))
+
+  (add-to-list 'auto-mode-alist
+	       (cons (concat (regexp-quote spec) "\\'") 'ada-mode))
+  (add-to-list 'auto-mode-alist
+	       (cons (concat (regexp-quote body) "\\'") 'ada-mode))
+
+  (add-to-list 'ada-spec-suffixes spec)
+  (add-to-list 'ada-body-suffixes body)
+
+  ;; Support for speedbar (Specifies that we want to see these files in
+  ;; speedbar)
+  (if (fboundp 'speedbar-add-supported-extension)
+      (progn
+        (funcall (symbol-function 'speedbar-add-supported-extension)
+                 spec)
+        (funcall (symbol-function 'speedbar-add-supported-extension)
+                 body)))
   )
 
 
 ;;;###autoload
 (defun ada-mode ()
-  "Ada Mode is the major mode for editing Ada code.
+  "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]'
 
  Re-format the parameter-list point is in             '\\[ada-format-paramlist]'
  Indent all lines in region                           '\\[ada-indent-region]'
- Call external pretty printer program                 '\\[ada-call-pretty-printer]'
 
  Adjust case of identifiers and keywords in region    '\\[ada-adjust-case-region]'
  Adjust case of identifiers and keywords in buffer    '\\[ada-adjust-case-buffer]'
 
- Call EXTERNAL pretty printer (if you have one)       '\\[ada-call-pretty-printer]'
+ Fill comment paragraph, justify and append postfix   '\\[fill-paragraph]'
 
- Fill comment paragraph                               '\\[ada-fill-comment-paragraph]'
- Fill comment paragraph and justify each line         '\\[ada-fill-comment-paragraph-justify]'
- Fill comment paragraph, justify and append postfix   '\\[ada-fill-comment-paragraph-postfix]'
-
- Next func/proc/task  '\\[ada-next-procedure]'    Previous func/proc/task '\\[ada-previous-procedure]'
- Next package         '\\[ada-next-package]'  Previous package        '\\[ada-previous-package]'
+ Next func/proc/task '\\[ada-next-procedure]'  Previous func/proc/task '\\[ada-previous-procedure]'
+ Next package        '\\[ada-next-package]'  Previous package        '\\[ada-previous-package]'
 
  Goto matching start of current 'end ...;'            '\\[ada-move-to-start]'
  Goto end of current block                            '\\[ada-move-to-end]'
@@ -398,74 +1106,280 @@ If you use find-file.el:
                                                    or '\\[ff-mouse-find-other-file]
  Switch to other file in other window                 '\\[ada-ff-other-window]'
                                                    or '\\[ff-mouse-find-other-file-other-window]
+ If you use this function in a spec and no body is available, it gets created with body stubs.
 
 If you use ada-xref.el:
  Goto declaration:          '\\[ada-point-and-xref]' on the identifier
                          or '\\[ada-goto-declaration]' with point on the identifier
- Complete identifier:       '\\[ada-complete-identifier]'
- Execute Gnatf:             '\\[ada-gnatf-current]'"
+ Complete identifier:       '\\[ada-complete-identifier]'."
 
   (interactive)
   (kill-all-local-variables)
 
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
+  (set (make-local-variable 'require-final-newline) t)
 
-  (make-local-variable 'comment-start)
-  (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 (make-local-variable 'paragraph-separate) "[ \t\n\f]*$")
 
   ;; comment end must be set because it may hold a wrong value if
   ;; this buffer had been in another mode before. RE
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-
-  (make-local-variable 'comment-start-skip) ;; used by autofill
-  (setq comment-start-skip "--+[ \t]*")
-
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'ada-indent-current-function)
+  (set (make-local-variable 'comment-end) "")
 
-  (make-local-variable 'fill-column)
-  (setq fill-column 75)
+  ;; used by autofill and indent-new-comment-line
+  (set (make-local-variable 'comment-start-skip) "---*[ \t]*")
 
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
+  ;; used by autofill to break a comment line and continue it on another line.
+  ;; The reason we need this one is that the default behavior does not work
+  ;; correctly with the definition of paragraph-start above when the comment
+  ;; is right after a multi-line subprogram declaration (the comments are
+  ;; aligned under the latest parameter, not under the declaration start).
+  (set (make-local-variable 'comment-line-break-function)
+       (lambda (&optional soft) (let ((fill-prefix nil))
+                                  (indent-new-comment-line soft))))
 
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
+  (set (make-local-variable 'indent-line-function)
+       'ada-indent-current-function)
 
-  (make-local-variable 'case-fold-search)
-  (setq case-fold-search t)
+  (set (make-local-variable 'comment-column) 40)
 
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'ada-fill-comment-paragraph)
-
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(ada-font-lock-keywords nil t ((?\_ . "w"))))
-
-  (setq major-mode 'ada-mode)
-  (setq mode-name "Ada")
+  ;;  Emacs 20.3 defines a comment-padding to insert spaces between
+  ;;  the comment and the text. We do not want any, this is already
+  ;;  included in comment-start
+  (unless (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 blink-matching-paren 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 'imenu-generic-expression)
+       ada-imenu-generic-expression)
+
+  ;;  Support for compile.el
+  ;;  We just substitute our own functions to go to the error.
+  (add-hook 'compilation-mode-hook
+            (lambda()
+	      (set (make-local-variable 'compile-auto-highlight) 40)
+	      ;; FIXME: This has global impact!  -stef
+	      (define-key compilation-minor-mode-map [mouse-2]
+		'ada-compile-mouse-goto-error)
+	      (define-key compilation-minor-mode-map "\C-c\C-c"
+		'ada-compile-goto-error)
+	      (define-key compilation-minor-mode-map "\C-m"
+		'ada-compile-goto-error)))
+
+  ;;  font-lock support :
+  ;;  We need to set some properties for XEmacs, and define some variables
+  ;;  for Emacs
+
+  (if (featurep 'xemacs)
+      ;;  XEmacs
+      (put 'ada-mode 'font-lock-defaults
+           '(ada-font-lock-keywords
+             nil t ((?\_ . "w") (?# . ".")) beginning-of-line))
+    ;;  Emacs
+    (set (make-local-variable 'font-lock-defaults)
+         '(ada-font-lock-keywords
+           nil t
+           ((?\_ . "w") (?# . "."))
+           beginning-of-line
+           (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
+    )
+
+  ;; Set up support for find-file.el.
+  (set (make-local-variable 'ff-other-file-alist)
+       'ada-other-file-alist)
+  (set (make-local-variable 'ff-search-directories)
+       'ada-search-directories-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
+  ;; standard find-file.el
+  (make-local-variable 'ff-special-constructs)
+
+  ;; Go to the parent package :
+  (add-to-list 'ff-special-constructs
+               (cons (eval-when-compile
+                       (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
+                               "\\(body[ \t]+\\)?"
+                               "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
+                     (lambda ()
+		       (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 ()
+		       (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,
+  ;;  since it uses the old ada-spec-suffix variable
+  ;; This one needs to replace the standard one defined in find-file.el (with
+  ;;  Emacs <= 20.4), since that one uses the old variable ada-spec-suffix
+  (let ((old-construct
+         (assoc "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" ff-special-constructs))
+        (new-cdr
+         (lambda ()
+	   (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
+                   (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
+                         new-cdr))))
+
+  ;;  Support for outline-minor-mode
+  (set (make-local-variable 'outline-regexp)
+       "\\([ \t]*\\(procedure\\|function\\|package\\|if\\|while\\|for\\|declare\\|case\\|end\\|begin\\|loop\\)\\|--\\)")
+  (set (make-local-variable 'outline-level) 'ada-outline-level)
+
+  ;;  Support for imenu : We want a sorted index
+  (setq imenu-sort-function 'imenu--sort-by-name)
+
+  ;;  Support for ispell : Check only comments
+  (set (make-local-variable 'ispell-check-comments) 'exclusive)
+
+  ;;  Support for align.el <= 2.2, if present
+  ;;  align.el is distributed with Emacs 21, but not with earlier versions.
+  (if (boundp 'align-mode-alist)
+      (add-to-list 'align-mode-alist '(ada-mode . ada-align-list)))
+
+  ;;  Support for align.el >= 2.8, if present
+  (if (boundp 'align-dq-string-modes)
+      (progn
+	(add-to-list 'align-dq-string-modes 'ada-mode)
+	(add-to-list 'align-open-comment-modes 'ada-mode)
+	(set (make-variable-buffer-local 'align-region-separate)
+	     ada-align-region-separate)
+
+	;; Exclude comments alone on line from alignment.
+	(add-to-list 'align-exclude-rules-list
+		     '(ada-solo-comment
+		       (regexp  . "^\\(\\s-*\\)--")
+		       (modes   . '(ada-mode))))
+	(add-to-list 'align-exclude-rules-list
+		     '(ada-solo-use
+		       (regexp  . "^\\(\\s-*\\)\\<use\\>")
+		       (modes   . '(ada-mode))))
+
+	(setq ada-align-modes nil)
+
+	(add-to-list 'ada-align-modes
+		     '(ada-declaration-assign
+		       (regexp  . "[^:]\\(\\s-*\\):[^:]")
+		       (valid   . (lambda() (not (ada-in-comment-p))))
+		       (repeat . t)
+		       (modes   . '(ada-mode))))
+	(add-to-list 'ada-align-modes
+		     '(ada-associate
+		       (regexp  . "[^=]\\(\\s-*\\)=>")
+		       (valid   . (lambda() (not (ada-in-comment-p))))
+		       (modes   . '(ada-mode))))
+	(add-to-list 'ada-align-modes
+		     '(ada-comment
+		       (regexp  . "\\(\\s-*\\)--")
+		       (modes   . '(ada-mode))))
+	(add-to-list 'ada-align-modes
+		     '(ada-use
+		       (regexp  . "\\(\\s-*\\)\\<use\\s-")
+		       (valid   . (lambda() (not (ada-in-comment-p))))
+		       (modes   . '(ada-mode))))
+	(add-to-list 'ada-align-modes
+		     '(ada-at
+		       (regexp . "\\(\\s-+\\)at\\>")
+		       (modes . '(ada-mode))))
+
+
+	(setq align-mode-rules-list ada-align-modes)
+	))
+
+  ;;  Set up the contextual menu
+  (if ada-popup-key
+      (define-key ada-mode-map ada-popup-key 'ada-popup-menu))
+
+  ;;  Support for Abbreviations (the user still need to "M-x abbrev-mode"
+  (define-abbrev-table 'ada-mode-abbrev-table ())
+  (setq local-abbrev-table ada-mode-abbrev-table)
+
+  ;;  Support for which-function mode
+  ;; which-function-mode does not work with nested subprograms, since it is
+  ;; based only on the regexps generated by imenu, and thus can only detect the
+  ;; beginning of subprograms, not the end.
+  ;; Fix is: redefine a new function ada-which-function, and call it when the
+  ;; major-mode is ada-mode.
+
+  (make-local-variable 'which-func-functions)
+  (setq which-func-functions '(ada-which-function))
+
+  ;;  Support for indent-new-comment-line (Especially for XEmacs)
+  (setq comment-multi-line nil)
+
+  (setq major-mode 'ada-mode
+	mode-name "Ada")
 
   (use-local-map ada-mode-map)
 
-  (if ada-mode-syntax-table
-      (set-syntax-table ada-mode-syntax-table)
-    (ada-create-syntax-table))
+  (easy-menu-add ada-mode-menu ada-mode-map)
+
+  (set-syntax-table ada-mode-syntax-table)
 
   (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 'ada-remove-trailing-spaces)
-	;; convert all tabs to the correct number of spaces.
-	(add-hook 'local-write-file-hooks 'ada-untabify-buffer)))
+        ;; remove all spaces at the end of lines in the whole buffer.
+	(add-hook 'local-write-file-hooks 'delete-trailing-whitespace)
+        ;; convert all tabs to the correct number of spaces.
+        (add-hook 'local-write-file-hooks
+                  (lambda () (untabify (point-min) (point-max))))))
+
+  (run-hooks 'ada-mode-hook)
 
+  ;;  To be run after the hook, in case the user modified
+  ;;  ada-fill-comment-prefix
+  (make-local-variable 'comment-start)
+  (if ada-fill-comment-prefix
+      (set 'comment-start ada-fill-comment-prefix)
+    (set 'comment-start "-- "))
 
-  ;; add menu 'Ada' to the menu bar
-  (ada-add-ada-menu)
+  ;;  Run this after the hook to give the users a chance to activate
+  ;;  font-lock-mode
 
-  (run-hooks 'ada-mode-hook)
+  (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
@@ -473,478 +1387,507 @@ If you use ada-xref.el:
 
   (cond ((eq ada-language-version 'ada83)
          (setq ada-keywords ada-83-keywords))
-        ((eq ada-language-version 'ada94)
-         (setq ada-keywords ada-94-keywords)))
+        ((eq ada-language-version 'ada95)
+         (setq ada-keywords ada-95-keywords)))
 
   (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))))
+
 
-;;;--------------------------
-;;;  Fill Comment Paragraph
-;;;--------------------------
+;;-----------------------------------------------------------------
+;;                      auto-casing
+;; Since Ada is case-insensitive, the Ada-mode provides an extensive set of
+;; functions to auto-case identifiers, keywords, ...
+;; The basic rules for autocasing are defined through the variables
+;; `ada-case-attribute', `ada-case-keyword' and `ada-case-identifier'. These
+;; are references to the functions that will do the actual casing.
+;;
+;; However, in most cases, the user will want to define some exceptions to
+;; these casing rules. This is done through a list of files, that contain
+;; one word per line. These files are stored in `ada-case-exception-file'.
+;; 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-fill-comment-paragraph-justify ()
-  "Fills current comment paragraph and justifies each line as well."
+(defun ada-create-case-exception (&optional word)
+  "Defines WORD as an exception for the casing system.
+If WORD is not given, then the current word in the buffer is used instead.
+The 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)
-  (ada-fill-comment-paragraph t))
+  (let ((previous-syntax-table (syntax-table))
+        file-name
+        )
+
+    (cond ((stringp ada-case-exception-file)
+           (setq file-name ada-case-exception-file))
+          ((listp ada-case-exception-file)
+           (setq file-name (car ada-case-exception-file)))
+          (t
+           (error (concat "No exception file specified. "
+			  "See variable ada-case-exception-file."))))
+
+    (set-syntax-table ada-mode-symbol-syntax-table)
+    (unless word
+      (save-excursion
+        (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,
+    (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 '()))
+             (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))
+      )
 
+    (ada-save-exceptions-to-file file-name)
+    ))
 
-(defun ada-fill-comment-paragraph-postfix ()
-  "Fills current comment paragraph and justifies each line as well.
-Prompts for a postfix to be appended to each line."
+(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)
-  (ada-fill-comment-paragraph t t))
+  (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))))
 
-(defun ada-fill-comment-paragraph (&optional justify postfix)
-  "Fills the current comment paragraph.
-If JUSTIFY is non-nil, each line is justified as well.
-If POSTFIX and JUSTIFY are  non-nil, ada-fill-comment-postfix is appended
-to each filled and justified line.
-If ada-indent-comment-as code is non-nil, the paragraph is idented."
-  (interactive "P")
-  (let ((opos (point-marker))
-        (begin nil)
-        (end nil)
-        (end-2 nil)
-        (indent nil)
-        (ada-fill-comment-old-postfix "")
-        (fill-prefix nil))
-
-    ;; check if inside comment
-    (if (not (ada-in-comment-p))
-        (error "not inside comment"))
-
-    ;; prompt for postfix if wanted
-    (if (and justify
-             postfix)
-        (setq ada-fill-comment-postfix
-              (read-from-minibuffer "enter new postfix string: "
-                                    ada-fill-comment-postfix)))
-
-    ;; prompt for old postfix to remove if necessary
-    (if (and justify
-             postfix)
-        (setq ada-fill-comment-old-postfix
-              (read-from-minibuffer "enter already existing postfix string: "
-                                    ada-fill-comment-postfix)))
+     (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))
+      )
 
-    ;;
-    ;; find limits of paragraph
-    ;;
-    (message "filling comment paragraph ...")
-    (save-excursion
-      (back-to-indentation)
-      ;; find end of paragraph
-      (while (and (looking-at "--.*$")
-                  (not (looking-at "--[ \t]*$")))
-        (forward-line 1)
-        (back-to-indentation))
-      (beginning-of-line)
-      (setq end (point-marker))
-      (goto-char opos)
-      ;; find begin of paragraph
-      (back-to-indentation)
-      (while (and (looking-at "--.*$")
-                  (not (looking-at "--[ \t]*$")))
-        (forward-line -1)
-        (back-to-indentation))
-      (forward-line 1)
-      ;; get indentation to calculate width for filling
-      (ada-indent-current)
-      (back-to-indentation)
-      (setq indent (current-column))
-      (setq begin (point-marker)))
+    (ada-save-exceptions-to-file file-name)
 
-    ;; delete old postfix if necessary
-    (if (and justify
-             postfix)
-        (save-excursion
-          (goto-char begin)
-          (while (re-search-forward (concat ada-fill-comment-old-postfix
-                                            "\n")
-                                    end t)
-            (replace-match "\n"))))
+    (message (concat "Defining " word " as a casing exception"))))
 
-    ;; delete leading whitespace and uncomment
-    (save-excursion
-      (goto-char begin)
-      (beginning-of-line)
-      (while (re-search-forward "^[ \t]*--[ \t]*" end t)
-        (replace-match "")))
-
-    ;; calculate fill width
-    (setq fill-column (- fill-column indent
-                         (length ada-fill-comment-prefix)
-                         (if postfix
-                             (length ada-fill-comment-postfix)
-                           0)))
-    ;; fill paragraph
-    (fill-region begin (1- end) justify)
-    (setq fill-column (+ fill-column indent
-                         (length ada-fill-comment-prefix)
-                         (if postfix
-                             (length ada-fill-comment-postfix)
-                           0)))
-   ;; find end of second last line
-    (save-excursion
-      (goto-char end)
-      (forward-line -2)
-      (end-of-line)
-      (setq end-2 (point-marker)))
+(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))
+      (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))
+
+          ;; If the item is already in the list, even with an other casing,
+          ;; do not add it again. This way, the user can easily decide which
+          ;; priority should be applied to each casing exception
+          (let ((word (buffer-substring-no-properties
+                       (point) (save-excursion (forward-word 1) (point)))))
+
+	    ;;  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)
+        (set-buffer buffer)))
+  )
 
-    ;; re-comment and re-indent region
-    (save-excursion
-      (goto-char begin)
-      (indent-to indent)
-      (insert ada-fill-comment-prefix)
-      (while (re-search-forward "\n" (1- end-2) t)
-        (replace-match (concat "\n" ada-fill-comment-prefix))
-        (beginning-of-line)
-        (indent-to indent)))
+(defun ada-case-read-exceptions ()
+  "Read all the casing exception files from `ada-case-exception-file'."
+  (interactive)
 
-    ;; append postfix if wanted
-    (if (and justify
-             postfix
-             ada-fill-comment-postfix)
-        (progn
-          ;; append postfix up to there
-          (save-excursion
-            (goto-char begin)
-            (while (re-search-forward "\n" (1- end-2) t)
-              (replace-match (concat ada-fill-comment-postfix "\n")))
+  ;;  Reinitialize the casing exception list
+  (setq ada-case-exception '()
+	ada-case-exception-substring '())
 
-            ;; fill last line and append postfix
-            (end-of-line)
-            (insert-char ?
-                         (- fill-column
-                            (current-column)
-                            (length ada-fill-comment-postfix)))
-            (insert ada-fill-comment-postfix))))
+  (cond ((stringp ada-case-exception-file)
+         (ada-case-read-exceptions-from-file ada-case-exception-file))
 
-    ;; delete the extra line that gets inserted somehow(??)
-    (save-excursion
-      (goto-char (1- end))
-      (end-of-line)
-      (delete-char 1))
+        ((listp ada-case-exception-file)
+         (mapcar 'ada-case-read-exceptions-from-file
+                 ada-case-exception-file))))
 
-     (message "filling comment paragraph ... done")
-    (goto-char opos))
-  t)
+(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)
 
-
-;;;--------------------------------;;;
-;;;  Call External Pretty Printer  ;;;
-;;;--------------------------------;;;
-
-(defun ada-call-pretty-printer ()
-  "Calls the external Pretty Printer.
-The name is specified in ada-external-pretty-print-program.  Saves the
-current buffer in a directory specified by ada-tmp-directory,
-starts the Pretty Printer as external process on that file and then
-reloads the beautyfied program in the buffer and cleans up
-ada-tmp-directory."
+    (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
+the exceptions defined in `ada-case-exception-file'."
   (interactive)
-  (let ((filename-with-path buffer-file-name)
-        (curbuf (current-buffer))
-        (orgpos (point))
-        (mesgbuf nil) ;; for byte-compiling
-        (file-path (file-name-directory buffer-file-name))
-        (filename-without-path (file-name-nondirectory buffer-file-name))
-        (tmp-file-with-directory
-         (concat ada-tmp-directory
-                 (file-name-nondirectory buffer-file-name))))
-    ;;
-    ;; save buffer in temporary file
-    ;;
-    (message "saving current buffer to temporary file ...")
-    (write-file tmp-file-with-directory)
-    (auto-save-mode nil)
-    (message "saving current buffer to temporary file ... done")
-    ;;
-    ;; call external pretty printer program
-    ;;
+  (if (or (equal ada-case-exception '())
+          (equal (char-after) ?_))
+      (progn
+	(funcall ada-case-identifier -1)
+	(ada-adjust-case-substring))
 
-    (message "running external pretty printer ...")
-    ;; create a temporary buffer for messages of pretty printer
-    (setq mesgbuf (get-buffer-create "Pretty Printer Messages"))
-    ;; execute pretty printer on temporary file
-    (call-process ada-external-pretty-print-program
-                  nil mesgbuf t
-                  tmp-file-with-directory)
-    ;; display messages if there are some
-    (if (buffer-modified-p mesgbuf)
-        ;; show the message buffer
-        (display-buffer mesgbuf t)
-      ;; kill the message buffer
-      (kill-buffer mesgbuf))
-    (message "running external pretty printer ... done")
-    ;;
-    ;; kill current buffer and load pretty printer output
-    ;; or restore old buffer
-    ;;
-    (if (y-or-n-p
-         "Really replace current buffer with pretty printer output ? ")
-        (progn
-          (set-buffer-modified-p nil)
-          (kill-buffer curbuf)
-          (find-file tmp-file-with-directory))
-      (message "old buffer contents restored"))
-    ;;
-    ;; delete temporary file and restore information of current buffer
-    ;;
-    (delete-file tmp-file-with-directory)
-    (set-visited-file-name filename-with-path)
-    (auto-save-mode t)
-    (goto-char orgpos)))
+    (progn
+      (let ((end   (point))
+            (start (save-excursion (skip-syntax-backward "w")
+                                   (point)))
+            match)
+        ;;  If we have an exception, replace the word by the correct casing
+        (if (setq match (assoc-string (buffer-substring start end)
+				      ada-case-exception t))
 
-
-;;;---------------
-;;;  auto-casing
-;;;---------------
+            (progn
+              (delete-region start end)
+              (insert (car match)))
 
-;; from Philippe Waroquiers <philippe@cfmu.eurocontrol.be>
-;; modifiedby RE and MH
+          ;;  Else simply re-case the word
+          (funcall ada-case-identifier -1)
+	  (ada-adjust-case-substring))))))
 
 (defun ada-after-keyword-p ()
-  ;; returns t if cursor is after a keyword.
+  "Returns t if cursor is after a keyword that is not an attribute."
   (save-excursion
     (forward-word -1)
-    (and (save-excursion
-           (or
-            (= (point) (point-min))
-            (backward-char 1))
-           (not (looking-at "_")))     ; (MH)
+    (and (not (and (char-before)
+                   (or (= (char-before) ?_)
+                       (= (char-before) ?'))));; unless we have a _ or '
          (looking-at (concat ada-keywords "[^_]")))))
 
-(defun ada-after-char-p ()
-  ;; returns t if after ada character "'".
-  (save-excursion
-    (if (> (point) 2)
-        (progn
-          (forward-char -2)
-          (looking-at "'"))
-      nil)))
-
-
 (defun ada-adjust-case (&optional force-identifier)
-  "Adjust the case of the word before the just-typed character,
-according to ada-case-keyword and ada-case-identifier
-If FORCE-IDENTIFIER is non-nil then also adjust keyword as
-identifier." ; (MH)
-  (forward-char -1)
-  (if (and (> (point) 1) (not (or (ada-in-string-p)
-                                  (ada-in-comment-p)
-                                  (ada-after-char-p))))
-      (if (eq (char-syntax (char-after (1- (point)))) ?w)
-          (if (and
-               (not force-identifier) ; (MH)
-               (ada-after-keyword-p))
-              (funcall ada-case-keyword -1)
-            (funcall ada-case-identifier -1))))
-  (forward-char 1))
-
+  "Adjust the case of the word before the just typed character.
+If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier."
+  (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)
+  "Adjust the case of the previous word, and process the character just typed.
+ARG is the prefix the user entered with \C-u."
   (interactive "P")
-  (let ((lastk last-command-char))
-    (cond ((or (eq lastk ?\n)
-               (eq lastk ?\r))
-           ;; horrible kludge
-           (insert " ")
-           (ada-adjust-case)
-           ;; horrible dekludge
-           (delete-backward-char 1)
-           ;; some special keys and their bindings
-           (cond
-            ((eq lastk ?\n)
-             (funcall ada-lfd-binding))
-            ((eq lastk ?\r)
-             (funcall ada-ret-binding))))
-          ((eq lastk ?\C-i) (ada-tab))
-          ((self-insert-command (prefix-numeric-value arg))))
-    ;; if there is a keyword in front of the underscore
-    ;; then it should be part of an identifier (MH)
-    (if (eq lastk ?_)
-        (ada-adjust-case t)
-      (ada-adjust-case))))
 
+  (if ada-auto-case
+      (let ((lastk last-command-char)
+            (previous-syntax-table (syntax-table)))
+
+	(unwind-protect
+	    (progn
+	      (set-syntax-table ada-mode-symbol-syntax-table)
+	      (cond ((or (eq lastk ?\n)
+			 (eq lastk ?\r))
+		     ;; horrible kludge
+		     (insert " ")
+		     (ada-adjust-case)
+		     ;; horrible dekludge
+		     (delete-backward-char 1)
+		     ;; some special keys and their bindings
+		     (cond
+		      ((eq lastk ?\n)
+		       (funcall ada-lfd-binding))
+		      ((eq lastk ?\r)
+		       (funcall ada-ret-binding))))
+		    ((eq lastk ?\C-i) (ada-tab))
+		    ;; Else just insert the character
+              ((self-insert-command (prefix-numeric-value arg))))
+	      ;; if there is a keyword in front of the underscore
+	      ;; then it should be part of an identifier (MH)
+	      (if (eq lastk ?_)
+		  (ada-adjust-case t)
+		(ada-adjust-case))
+	      )
+	  ;; Restore the syntax table
+	  (set-syntax-table previous-syntax-table))
+        )
+
+    ;; Else, no auto-casing
+    (cond
+     ((eq last-command-char ?\n)
+      (funcall ada-lfd-binding))
+     ((eq last-command-char ?\r)
+      (funcall ada-ret-binding))
+     (t
+      (self-insert-command (prefix-numeric-value arg))))
+    ))
 
 (defun ada-activate-keys-for-case ()
-  ;; save original keybindings to allow swapping ret/lfd
-  ;; when casing is activated
-  ;; the 'or ...' is there to be sure that the value will not
-  ;; be changed again when ada-mode is called more than once (MH)
-  (or ada-ret-binding
-      (setq ada-ret-binding (key-binding "\C-M")))
-  (or ada-lfd-binding
-      (setq ada-lfd-binding (key-binding "\C-j")))
-  ;; call case modifying function after certain keys.
+  "Modifies the key bindings for all the keys that should readjust the casing."
+  (interactive)
+  ;; Save original key-bindings to allow swapping ret/lfd
+  ;; when casing is activated.
+  ;; The 'or ...' is there to be sure that the value will not
+  ;; be changed again when Ada mode is called more than once
+  (or ada-ret-binding    (setq ada-ret-binding (key-binding "\C-M")))
+  (or ada-lfd-binding    (setq ada-lfd-binding (key-binding "\C-j")))
+
+  ;; Call case modifying function after certain keys.
   (mapcar (function (lambda(key) (define-key
                                    ada-mode-map
                                    (char-to-string key)
                                    'ada-adjust-case-interactive)))
-          '( ?` ?~ ?! ?@ ?# ?$ ?% ?^ ?& ?* ?( ?)  ?- ?= ?+ ?[ ?{ ?] ?}
-                ?_ ?\\ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?? ?/ ?\n 32 ?\r )))
-;; deleted ?\t from above list
+          '( ?` ?_ ?# ?% ?& ?* ?( ?) ?- ?= ?+
+                ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r )))
 
-;;
-;; added by MH
-;;
 (defun ada-loose-case-word (&optional arg)
-  "Capitalizes the first and the letters following _
-ARG is ignored, it's there to fit the standard casing functions' style."
-  (let ((pos (point))
-        (first t))
-    (skip-chars-backward "a-zA-Z0-9_")
-    (while (or first
-               (search-forward "_" pos t))
-      (and first
-           (setq first nil))
-      (insert-char (upcase (following-char)) 1)
-      (delete-char 1))
-    (goto-char pos)))
+  "Upcase first letter and letters following `_' in the following word.
+No other letter is modified.
+ARG is ignored, and is there for compatibility with `capitalize-word' only."
+  (interactive)
+  (save-excursion
+    (let ((end   (save-excursion (skip-syntax-forward  "w") (point)))
+          (first t))
+      (skip-syntax-backward "w")
+      (while (and (or first (search-forward "_" end t))
+                  (< (point) end))
+        (and first
+             (setq first nil))
+        (insert-char (upcase (following-char)) 1)
+        (delete-char 1)))))
+
+(defun ada-no-auto-case (&optional arg)
+  "Does nothing.
+This function can be used for the auto-casing variables in the ada-mode, to
+adapt to unusal auto-casing schemes. Since it does nothing, you can for
+instance use it for `ada-case-identifier' if you don't want any special
+auto-casing for identifiers, whereas keywords have to be lower-cased.
+See also `ada-auto-case' to disable auto casing altogether."
+  )
 
+(defun ada-capitalize-word (&optional arg)
+  "Upcase first letter and letters following '_', lower case other letters.
+ARG is ignored, and is there for compatibility with `capitalize-word' only."
+  (interactive)
+  (let ((end   (save-excursion (skip-syntax-forward  "w") (point)))
+        (begin (save-excursion (skip-syntax-backward "w") (point))))
+    (modify-syntax-entry ?_ "_")
+    (capitalize-region begin end)
+    (modify-syntax-entry ?_ "w")))
 
-;;
-;; added by MH
-;;
 (defun ada-adjust-case-region (from to)
-  "Adjusts the case of all identifiers and keywords in the region.
-ATTENTION: This function might take very long for big regions !"
+  "Adjusts the case of all words in the region between FROM and TO.
+Attention: This function might take very long for big regions !"
   (interactive "*r")
   (let ((begin nil)
         (end nil)
         (keywordp nil)
-        (reldiff nil))
-    (save-excursion
-      (goto-char to)
-      ;;
-      ;; loop: look for all identifiers and keywords
-      ;;
-      (while (re-search-backward
-              "[^a-zA-Z0-9_]\\([a-zA-Z0-9_]+\\)[^a-zA-Z0-9_]"
-              from
-              t)
-        ;;
-        ;; print status message
-        ;;
-        (setq reldiff (- (point) from))
-        (message (format "adjusting case ... %5d characters left"
-                         (- (point) from)))
-        (forward-char 1)
-        (or
-         ;; do nothing if it is a string or comment
-         (ada-in-string-or-comment-p)
-         (progn
-             ;;
-             ;; get the identifier or keyword
-             ;;
-             (setq begin (point))
-             (setq keywordp (looking-at (concat ada-keywords "[^_]")))
-             (skip-chars-forward "a-zA-Z0-9_")
-           ;;
-           ;; casing according to user-option
-           ;;
-           (if keywordp
-               (funcall ada-case-keyword -1)
-             (funcall ada-case-identifier -1))
-           (goto-char begin))))
-      (message "adjusting case ... done"))))
-
+        (attribp nil)
+        (previous-syntax-table (syntax-table)))
+    (message "Adjusting case ...")
+    (unwind-protect
+        (save-excursion
+          (set-syntax-table ada-mode-symbol-syntax-table)
+          (goto-char to)
+          ;;
+          ;; loop: look for all identifiers, keywords, and attributes
+          ;;
+          (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
+            (setq end (match-end 1))
+            (setq attribp
+                 (and (> (point) from)
+                      (save-excursion
+                        (forward-char -1)
+                        (setq attribp (looking-at "'.[^']")))))
+            (or
+             ;; do nothing if it is a string or comment
+             (ada-in-string-or-comment-p)
+             (progn
+               ;;
+               ;; get the identifier or keyword or attribute
+               ;;
+               (setq begin (point))
+               (setq keywordp (looking-at ada-keywords))
+               (goto-char end)
+               ;;
+               ;; casing according to user-option
+               ;;
+               (if attribp
+                   (funcall ada-case-attribute -1)
+                 (if keywordp
+                     (funcall ada-case-keyword -1)
+                   (ada-adjust-case-identifier)))
+               (goto-char begin))))
+          (message "Adjusting case ... Done"))
+      (set-syntax-table previous-syntax-table))))
 
-;;
-;; added by MH
-;;
 (defun ada-adjust-case-buffer ()
-  "Adjusts the case of all identifiers and keywords in the whole buffer.
+  "Adjusts the case of all words in the whole buffer.
 ATTENTION: This function might take very long for big buffers !"
-  (interactive)
+  (interactive "*")
   (ada-adjust-case-region (point-min) (point-max)))
 
 
-;;;------------------------;;;
-;;; Format Parameter Lists ;;;
-;;;------------------------;;;
+;;--------------------------------------------------------------
+;; Format Parameter Lists
+;; Some special algorithms are provided to indent the parameter lists in
+;; subprogram declarations. This is done in two steps:
+;;  - First parses the parameter list. The returned list has the following
+;;    format:
+;;     ( (<Param_Name> in? out? access? <Type_Name> <Default_Expression>)
+;;       ... )
+;;    This is done in `ada-scan-paramlist'.
+;;  - Delete and recreate the parameter list in function
+;;    `ada-insert-paramlist'.
+;; Both steps are called from `ada-format-paramlist'.
+;; Note: Comments inside the parameter list are lost.
+;;       The syntax has to be correct, or the reformating will fail.
+;;--------------------------------------------------------------
 
 (defun ada-format-paramlist ()
-  "Re-formats a parameter-list.
-ATTENTION:  1) Comments inside the list are killed !
-            2) If the syntax is not correct (especially, if there are
-               semicolons missing), it can get totally confused !
-In such a case, use 'undo', correct the syntax and try again."
-
+  "Reformats the parameter list point is in."
   (interactive)
   (let ((begin nil)
         (end nil)
         (delend nil)
-        (paramlist nil))
-    ;;
-    ;; ATTENTION: modify sntax-table temporary !
-    ;;
-    (modify-syntax-entry ?_ "w")
+        (paramlist nil)
+        (previous-syntax-table (syntax-table)))
+    (unwind-protect
+        (progn
+          (set-syntax-table ada-mode-symbol-syntax-table)
 
-    ;; check if really inside parameter list
-    (or (ada-in-paramlist-p)
-        (error "not in parameter list"))
-    ;;
-    ;; find start of current parameter-list
-    ;;
-    (ada-search-ignore-string-comment
-     (concat "\\<\\("
-             "procedure\\|function\\|body\\|package\\|task\\|entry\\|accept"
-             "\\)\\>") t nil)
-    (ada-search-ignore-string-comment "(" nil nil t)
-    (backward-char 1)
-    (setq begin (point))
+          ;; check if really inside parameter list
+          (or (ada-in-paramlist-p)
+              (error "not in parameter list"))
 
-    ;;
-    ;; find end of parameter-list
-    ;;
-    (forward-sexp 1)
-    (setq delend (point))
-    (delete-char -1)
+          ;; find start of current parameter-list
+          (ada-search-ignore-string-comment
+           (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
+          (down-list 1)
+          (backward-char 1)
+          (setq begin (point))
 
-    ;;
-    ;; find end of last parameter-declaration
-    ;;
-    (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
-    (forward-char 1)
-    (setq end (point))
+          ;; find end of parameter-list
+          (forward-sexp 1)
+          (setq delend (point))
+          (delete-char -1)
+          (insert "\n")
 
-    ;;
-    ;; build a list of all elements of the parameter-list
-    ;;
-    (setq paramlist (ada-scan-paramlist (1+ begin) end))
+          ;; find end of last parameter-declaration
+          (forward-comment -1000)
+          (setq end (point))
 
-    ;;
-    ;; delete the original parameter-list
-    ;;
-    (delete-region begin (1- delend))
+          ;; build a list of all elements of the parameter-list
+          (setq paramlist (ada-scan-paramlist (1+ begin) end))
 
-    ;;
-    ;; insert the new parameter-list
-    ;;
-    (goto-char begin)
-    (ada-insert-paramlist paramlist)
+          ;; delete the original parameter-list
+          (delete-region begin  delend)
 
-    ;;
-    ;; restore syntax-table
-    ;;
-    (modify-syntax-entry ?_ "_")))
+          ;; insert the new parameter-list
+          (goto-char begin)
+          (ada-insert-paramlist paramlist))
 
+      ;; restore syntax-table
+      (set-syntax-table previous-syntax-table)
+      )))
 
 (defun ada-scan-paramlist (begin end)
-  ;; Scans a parameter-list  between BEGIN and END and returns a list
-  ;; of its contents.
-  ;; The list has the following format:
-  ;;
-  ;;   Name of Param  in? out? accept?  Name of Type   Default-Exp or nil
-  ;;
-  ;; ( ('Name_Param_1' t   nil    t      Type_Param_1   ':= expression')
-  ;;   ('Name_Param_2' nil nil    t      Type_Param_2    nil) )
-
+  "Scan the parameter list found in between BEGIN and END.
+Returns the equivalent internal parameter list."
   (let ((paramlist (list))
         (param (list))
         (notend t)
@@ -954,1108 +1897,1132 @@ In such a case, use 'undo', correct the syntax and try again."
         (match-cons nil))
 
     (goto-char begin)
-    ;;
+
     ;; loop until end of last parameter
-    ;;
     (while notend
 
-      ;;
       ;; find first character of parameter-declaration
-      ;;
       (ada-goto-next-non-ws)
       (setq apos (point))
 
-      ;;
       ;; find last character of parameter-declaration
-      ;;
       (if (setq match-cons
-                (ada-search-ignore-string-comment "[ \t\n]*;" nil end t))
+               (ada-search-ignore-string-comment "[ \t\n]*;" nil end t))
           (progn
             (setq epos (car match-cons))
             (setq semipos (cdr match-cons)))
         (setq epos end))
 
-      ;;
       ;; read name(s) of parameter(s)
-      ;;
       (goto-char apos)
-      (looking-at "\\([a-zA-Z0-9_, \t\n]*[a-zA-Z0-9_]\\)[ \t\n]*:[^=]")
+      (looking-at "\\(\\(\\sw\\|[_, \t\n]\\)*\\(\\sw\\|_\\)\\)[ \t\n]*:[^=]")
 
-      (setq param (list (buffer-substring (match-beginning 1)
-                                          (match-end 1))))
-      (ada-search-ignore-string-comment ":" nil epos t)
+      (setq param (list (match-string 1)))
+      (ada-search-ignore-string-comment ":" nil epos t 'search-forward)
 
-      ;;
       ;; look for 'in'
-      ;;
       (setq apos (point))
       (setq param
-            (append param
-                    (list
-                     (consp
-                      (ada-search-ignore-string-comment "\\<in\\>"
-                                                        nil
-                                                        epos
-                                                        t)))))
+           (append param
+                   (list
+                    (consp
+                     (ada-search-ignore-string-comment
+                      "in" nil epos t 'word-search-forward)))))
 
-      ;;
       ;; look for 'out'
-      ;;
       (goto-char apos)
       (setq param
-            (append param
-                    (list
-                     (consp
-                      (ada-search-ignore-string-comment "\\<out\\>"
-                                                        nil
-                                                        epos
-                                                        t)))))
+           (append param
+                   (list
+                    (consp
+                     (ada-search-ignore-string-comment
+                      "out" nil epos t 'word-search-forward)))))
 
-      ;;
-      ;; look for 'accept'
-      ;;
+      ;; look for 'access'
       (goto-char apos)
       (setq param
-            (append param
-                    (list
-                     (consp
-                      (ada-search-ignore-string-comment "\\<accept\\>"
-                                                        nil
-                                                        epos
-                                                        t)))))
+           (append param
+                   (list
+                    (consp
+                     (ada-search-ignore-string-comment
+                      "access" nil epos t 'word-search-forward)))))
 
-      ;;
-      ;; skip 'in'/'out'/'accept'
-      ;;
+      ;; skip 'in'/'out'/'access'
       (goto-char apos)
       (ada-goto-next-non-ws)
-      (while (looking-at "\\<\\(in\\|out\\|accept\\)\\>")
+      (while (looking-at "\\<\\(in\\|out\\|access\\)\\>")
         (forward-word 1)
         (ada-goto-next-non-ws))
 
-      ;;
       ;; read type of parameter
-      ;;
-      (looking-at "\\<[a-zA-Z0-9_\\.]+\\>")
+      ;; We accept spaces in the name, since some software like Rose
+      ;; generates something like: "A : B 'Class"
+      (looking-at "\\<\\(\\sw\\|[_.' \t]\\)+\\>")
       (setq param
-            (append param
-                    (list
-                     (buffer-substring (match-beginning 0)
-                                       (match-end 0)))))
+           (append param
+                   (list (match-string 0))))
 
-      ;;
       ;; read default-expression, if there is one
-      ;;
       (goto-char (setq apos (match-end 0)))
       (setq param
-            (append param
-                    (list
-                     (if (setq match-cons
-                               (ada-search-ignore-string-comment ":="
-                                                                 nil
-                                                                 epos
-                                                                 t))
-                         (buffer-substring (car match-cons)
-                                           epos)
-                       nil))))
-      ;;
+           (append param
+                   (list
+                    (if (setq match-cons
+                             (ada-search-ignore-string-comment
+                              ":=" nil epos t 'search-forward))
+                        (buffer-substring (car match-cons) epos)
+                      nil))))
+
       ;; add this parameter-declaration to the list
-      ;;
       (setq paramlist (append paramlist (list param)))
 
-      ;;
       ;; check if it was the last parameter
-      ;;
       (if (eq epos end)
           (setq notend nil)
         (goto-char semipos))
-
-      ) ; end of loop
-
+      )
     (reverse paramlist)))
 
-
 (defun ada-insert-paramlist (paramlist)
-  ;; Inserts a formatted PARAMLIST in the buffer.
-  ;; See doc of ada-scan-paramlist for the format.
+  "Inserts a formatted PARAMLIST in the buffer."
   (let ((i (length paramlist))
         (parlen 0)
         (typlen 0)
-        (temp 0)
         (inp nil)
         (outp nil)
-        (acceptp nil)
+        (accessp nil)
         (column nil)
-        (orgpoint 0)
         (firstcol nil))
 
-    ;;
     ;; loop until last parameter
-    ;;
     (while (not (zerop i))
       (setq i (1- i))
 
-      ;;
       ;; get max length of parameter-name
-      ;;
-      (setq parlen
-            (if (<= parlen (setq temp
-                              (length (nth 0 (nth i paramlist)))))
-                temp
-              parlen))
+      (setq parlen (max parlen (length (nth 0 (nth i paramlist)))))
 
-      ;;
       ;; get max length of type-name
-      ;;
-      (setq typlen
-            (if (<= typlen (setq temp
-                              (length (nth 4 (nth i paramlist)))))
-                temp
-              typlen))
+      (setq typlen (max typlen (length (nth 4 (nth i paramlist)))))
 
-      ;;
       ;; is there any 'in' ?
-      ;;
-      (setq inp
-            (or inp
-                (nth 1 (nth i paramlist))))
+      (setq inp (or inp (nth 1 (nth i paramlist))))
 
-      ;;
       ;; is there any 'out' ?
-      ;;
-      (setq outp
-            (or outp
-                (nth 2 (nth i paramlist))))
+      (setq outp (or outp (nth 2 (nth i paramlist))))
 
-      ;;
-      ;; is there any 'accept' ?
-      ;;
-      (setq acceptp
-            (or acceptp
-                (nth 3 (nth i paramlist))))) ; end of loop
+      ;; is there any 'access' ?
+      (setq accessp (or accessp (nth 3 (nth i paramlist))))
+      )
 
-    ;;
     ;; does paramlist already start on a separate line ?
-    ;;
     (if (save-excursion
           (re-search-backward "^.\\|[^ \t]" nil t)
           (looking-at "^."))
         ;; yes => re-indent it
-        (ada-indent-current)
-      ;;
-      ;; no => insert newline and indent it
-      ;;
-      (progn
-        (ada-indent-current)
-        (newline)
-        (delete-horizontal-space)
-        (setq orgpoint (point))
-        (setq column (save-excursion
-                       (funcall (ada-indent-function) orgpoint)))
-        (indent-to column)
-        ))
+        (progn
+          (ada-indent-current)
+          (save-excursion
+            (if (looking-at "\\(is\\|return\\)")
+                (replace-match " \\1"))))
+
+      ;; no => insert it where we are after removing any whitespace
+      (fixup-whitespace)
+      (save-excursion
+        (cond
+         ((looking-at "[ \t]*\\(\n\\|;\\)")
+          (replace-match "\\1"))
+         ((looking-at "[ \t]*\\(is\\|return\\)")
+          (replace-match " \\1"))))
+      (insert " "))
 
     (insert "(")
+    (ada-indent-current)
 
     (setq firstcol (current-column))
     (setq i (length paramlist))
 
-    ;;
     ;; loop until last parameter
-    ;;
     (while (not (zerop i))
       (setq i (1- i))
       (setq column firstcol)
 
-      ;;
       ;; insert parameter-name, space and colon
-      ;;
       (insert (nth 0 (nth i paramlist)))
       (indent-to (+ column parlen 1))
       (insert ": ")
       (setq column (current-column))
 
-      ;;
       ;; insert 'in' or space
-      ;;
       (if (nth 1 (nth i paramlist))
           (insert "in ")
         (if (and
              (or inp
-                 acceptp)
+                 accessp)
              (not (nth 3 (nth i paramlist))))
             (insert "   ")))
 
-      ;;
       ;; insert 'out' or space
-      ;;
       (if (nth 2 (nth i paramlist))
           (insert "out ")
         (if (and
              (or outp
-                 acceptp)
+                 accessp)
              (not (nth 3 (nth i paramlist))))
             (insert "    ")))
 
-      ;;
-      ;; insert 'accept'
-      ;;
+      ;; insert 'access'
       (if (nth 3 (nth i paramlist))
-          (insert "accept "))
+          (insert "access "))
 
       (setq column (current-column))
 
-      ;;
       ;; insert type-name and, if necessary, space and default-expression
-      ;;
       (insert (nth 4 (nth i paramlist)))
       (if (nth 5 (nth i paramlist))
           (progn
             (indent-to (+ column typlen 1))
             (insert (nth 5 (nth i paramlist)))))
 
-      ;;
       ;; check if it was the last parameter
-      ;;
-      (if (not (zerop i))
-          ;; no => insert ';' and newline and indent
-          (progn
-            (insert ";")
-            (newline)
-            (indent-to firstcol))
-        ;; yes
-        (insert ")"))
-
-      ) ; end of loop
+      (if (zerop i)
+          (insert ")")
+        ;; no => insert ';' and newline and indent
+        (insert ";")
+        (newline)
+        (indent-to firstcol))
+      )
 
-    ;;
-    ;; if anything follows, except semicolon:
+    ;; if anything follows, except semicolon, newline, is or return
     ;; put it in a new line and indent it
-    ;;
-    (if (not (looking-at "[ \t]*[;\n]"))
-        (ada-indent-newline-indent))
-
+    (unless (looking-at "[ \t]*\\(;\\|\n\\|is\\|return\\)")
+      (ada-indent-newline-indent))
     ))
 
-
-;;;----------------------------;;;
-;;; Move To Matching Start/End ;;;
-;;;----------------------------;;;
-
-(defun ada-move-to-start ()
-  "Moves point to the matching start of the current end ... around point."
-  (interactive)
-  (let ((pos (point)))
-    ;;
-    ;; ATTENTION: modify sntax-table temporary !
-    ;;
-    (modify-syntax-entry ?_ "w")
-
-    (message "searching for block start ...")
-    (save-excursion
-      ;;
-      ;; do nothing if in string or comment or not on 'end ...;'
-      ;;            or if an error occurs during processing
-      ;;
-      (or
-       (ada-in-string-or-comment-p)
-       (and (progn
-              (or (looking-at "[ \t]*\\<end\\>")
-                  (backward-word 1))
-              (or (looking-at "[ \t]*\\<end\\>")
-                  (backward-word 1))
-              (or (looking-at "[ \t]*\\<end\\>")
-                  (error "not on end ...;")))
-            (ada-goto-matching-start 1)
-            (setq pos (point))
-
-            ;;
-            ;; on 'begin' => go on, according to user option
-            ;;
-            ada-move-to-declaration
-            (looking-at "\\<begin\\>")
-            (ada-goto-matching-decl-start)
-            (setq pos (point))))
-
-      ) ; end of save-excursion
-
-    ;; now really move to the found position
-    (goto-char pos)
-    (message "searching for block start ... done")
-
-    ;;
-    ;; restore syntax-table
-    ;;
-    (modify-syntax-entry ?_ "_")))
-
-
-(defun ada-move-to-end ()
-  "Moves point to the matching end of the current block around point.
-Moves to 'begin' if in a declarative part."
-  (interactive)
-  (let ((pos (point))
-        (decstart nil)
-        (packdecl nil))
-    ;;
-    ;; ATTENTION: modify sntax-table temporary !
-    ;;
-    (modify-syntax-entry ?_ "w")
-
-    (message "searching for block end ...")
-    (save-excursion
-
-      (forward-char 1)
-      (cond
-       ;; 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\\>"))
-       ;; on first line of task declaration
-       ((save-excursion
-          (and (ada-goto-stmt-start)
-               (looking-at "\\<task\\>" )
-               (forward-word 1)
-               (ada-search-ignore-string-comment "[^ \n\t]")
-               (not (backward-char 1))
-               (looking-at "\\<body\\>")))
-        (ada-search-ignore-string-comment "\\<begin\\>"))
-       ;; accept block start
-       ((save-excursion
-          (and (ada-goto-stmt-start)
-               (looking-at "\\<accept\\>" )))
-        (ada-goto-matching-end 0))
-       ;; package start
-       ((save-excursion
-          (and (ada-goto-matching-decl-start t)
-               (looking-at "\\<package\\>")))
-        (ada-goto-matching-end 1))
-       ;; inside a 'begin' ... 'end' block
-       ((save-excursion
-          (ada-goto-matching-decl-start t))
-        (ada-search-ignore-string-comment "\\<begin\\>"))
-       ;; (hopefully ;-) everything else
-       (t
-        (ada-goto-matching-end 1)))
-      (setq pos (point))
-
-      ) ; end of save-excursion
-
-    ;; now really move to the found position
-    (goto-char pos)
-    (message "searching for block end ... done")
-
-    ;;
-    ;; restore syntax-table
-    ;;
-    (modify-syntax-entry ?_ "_")))
 
 
-;;;-----------------------------;;;
-;;;  Functions For Indentation  ;;;
-;;;-----------------------------;;;
-
-;; ---- main functions for indentation
+;;;----------------------------------------------------------------
+;;  Indentation Engine
+;;  All indentations are indicated as a two-element string:
+;;     - position of reference in the buffer
+;;     - offset to indent from this position (can also be a symbol or a list
+;;       that are evaluated)
+;;  Thus the total indentation for a line is the column number of the reference
+;;  position plus whatever value the evaluation of the second element provides.
+;;  This mechanism is used so that the ada-mode can "explain" how the
+;;  indentation was calculated, by showing which variables were used.
+;;
+;;  The indentation itself is done in only one pass: first we try to guess in
+;;  what context we are by looking at the following keyword or punctuation
+;;  sign. If nothing remarkable is found, just try to guess the indentation
+;;  based on previous lines.
+;;
+;;  The relevant functions for indentation are:
+;;  - `ada-indent-region': Re-indent a region of text
+;;  - `ada-justified-indent-current': Re-indent the current line and shows the
+;;    calculation that were done
+;;  - `ada-indent-current': Re-indent the current line
+;;  - `ada-get-current-indent': Calculate the indentation for the current line,
+;;    based on the context (see above).
+;;  - `ada-get-indent-*': Calculate the indentation in a specific context.
+;;    For efficiency, these functions do not check they are in the correct
+;;    context.
+;;;----------------------------------------------------------------
 
 (defun ada-indent-region (beg end)
-  "Indents the region using ada-indent-current on each line."
+  "Indent the region between BEG end END."
   (interactive "*r")
   (goto-char beg)
-  ;; catch errors while indenting
-  (condition-case err
-      (while (< (point) end)
-        (message (format "indenting ... %4d lines left"
-                         (count-lines (point) end)))
-        (ada-indent-current)
-        (forward-line 1))
-    ;; show line number where the error occured
-    (error
-     (error (format "line %d: %s"
-                    (1+ (count-lines (point-min) (point)))
-                    err) nil)))
-  (message "indenting ... done"))
-
+  (let ((block-done 0)
+        (lines-remaining (count-lines beg end))
+        (msg (format "%%4d out of %4d lines remaining ..."
+                     (count-lines beg end)))
+        (endmark (copy-marker end)))
+    ;; catch errors while indenting
+    (while (< (point) endmark)
+      (if (> block-done 39)
+          (progn
+	    (setq lines-remaining (- lines-remaining block-done)
+		  block-done     0)
+	    (message msg lines-remaining)))
+      (if (= (char-after) ?\n) nil
+        (ada-indent-current))
+      (forward-line 1)
+      (setq block-done      (1+ block-done)))
+    (message "indenting ... done")))
 
 (defun ada-indent-newline-indent ()
   "Indents the current line, inserts a newline and then indents the new line."
   (interactive "*")
-  (let ((column)
-        (orgpoint))
-
-    (ada-indent-current)
-    (newline)
-    (delete-horizontal-space)
-    (setq orgpoint (point))
-
-    ;;
-    ;; ATTENTION: modify syntax-table temporary !
-    ;;
-    (modify-syntax-entry ?_ "w")
-
-    (setq column (save-excursion
-                   (funcall (ada-indent-function) orgpoint)))
-
-    ;;
-    ;; restore syntax-table
-    ;;
-    (modify-syntax-entry ?_ "_")
+  (ada-indent-current)
+  (newline)
+  (ada-indent-current))
+
+(defun ada-indent-newline-indent-conditional ()
+  "Insert a newline and indent it.
+The original line is indented first if `ada-indent-after-return' is non-nil.
+This function is intended to be bound to the \C-m and \C-j keys."
+  (interactive "*")
+  (if ada-indent-after-return (ada-indent-current))
+  (newline)
+  (ada-indent-current))
 
-    (indent-to column)
-
-    ;; The following is needed to ensure that indentation will still be
-    ;; correct if something follows behind point when typing LFD
-    ;; For example: Imagine point to be there (*) when LFD is typed:
-    ;;              while cond loop
-    ;;                 null; *end loop;
-    ;; Result without the following statement would be:
-    ;;              while cond loop
-    ;;                 null;
-    ;;                *end loop;
-    ;; You would then have to type TAB to correct it.
-    ;; If that doesn't bother you, you can comment out the following
-    ;; statement to speed up indentation a LITTLE bit.
-
-    (if (not (looking-at "[ \t]*$"))
-        (ada-indent-current))
-    ))
+(defun ada-justified-indent-current ()
+  "Indent the current line and explains how the calculation was done."
+  (interactive)
 
+  (let ((cur-indent (ada-indent-current)))
+
+    (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))))
+
+(defun ada-batch-reformat ()
+  "Re-indent and re-case all the files found on the command line.
+This function should be used from the Unix/Windows command line, with a
+command like:
+  emacs -batch -l ada-mode -f ada-batch-reformat file1 file2 ..."
+
+  (while command-line-args-left
+    (let ((source (car command-line-args-left)))
+      (message (concat "formating " source))
+      (find-file source)
+      (ada-indent-region (point-min) (point-max))
+      (ada-adjust-case-buffer)
+      (write-file source))
+    (setq command-line-args-left (cdr command-line-args-left)))
+  (message "Done")
+  (kill-emacs 0))
+
+(defsubst ada-goto-previous-word ()
+  "Moves point to the beginning of the previous word of Ada code.
+Returns the new position of point or nil if not found."
+  (ada-goto-next-word t))
 
 (defun ada-indent-current ()
-  "Indents current line as Ada code.
-This works by two steps:
- 1) It moves point to the end of the previous code-line.
-    Then it calls the function to calculate the indentation for the
-    following line as if a newline would be inserted there.
-    The calculated column # is saved and the old position of point
-    is restored.
- 2) Then another function is called to calculate the indentation for
-    the current line, based on the previously calculated column #."
-
+  "Indent current line as Ada code.
+Returns the calculation that was done, including the reference point and the
+offset."
   (interactive)
-
-  ;;
-  ;; ATTENTION: modify sntax-table temporary !
-  ;;
-  (modify-syntax-entry ?_ "w")
-
-  (let ((line-end)
+  (let ((previous-syntax-table (syntax-table))
         (orgpoint (point-marker))
-        (cur-indent)
-        (prev-indent)
-        (prevline t))
+        cur-indent tmp-indent
+        prev-indent)
 
-    ;;
-    ;; first step
-    ;;
-    (save-excursion
-      (if (ada-goto-prev-nonblank-line t)
-          ;;
-          ;; we are not in the first accessible line in the buffer
-          ;;
-          (progn
-            (end-of-line)
-            (forward-char 1)
-            (setq line-end (point))
-            (setq prev-indent (save-excursion
-                                (funcall (ada-indent-function) line-end))))
-        (setq prevline nil)))
-
-    (if prevline
-        ;;
-        ;; we are not in the first accessible line in the buffer
-        ;;
+    (unwind-protect
         (progn
-          ;;
-          ;; second step
-          ;;
-          (back-to-indentation)
-          (setq cur-indent (ada-get-current-indent prev-indent))
-          (delete-horizontal-space)
-          (indent-to cur-indent)
+          (set-syntax-table ada-mode-symbol-syntax-table)
+
+          ;;  This need to be done here so that the advice is not always
+          ;;  activated (this might interact badly with other modes)
+          (if (featurep 'xemacs)
+              (ad-activate 'parse-partial-sexp t))
+
+          (save-excursion
+            (setq cur-indent
 
+                 ;; Not First line in the buffer ?
+                 (if (save-excursion (zerop (forward-line -1)))
+                     (progn
+                       (back-to-indentation)
+                       (ada-get-current-indent))
+
+                   ;; first line in the buffer
+                   (list (point-min) 0))))
+
+          ;; Evaluate the list to get the column to indent to
+          ;; prev-indent contains the column to indent to
+	  (if cur-indent
+	      (setq prev-indent (save-excursion (goto-char (car cur-indent))
+						(current-column))
+		    tmp-indent (cdr cur-indent))
+	    (setq prev-indent 0  tmp-indent '()))
+
+          (while (not (null tmp-indent))
+            (cond
+             ((numberp (car tmp-indent))
+              (setq prev-indent (+ prev-indent (car tmp-indent))))
+             (t
+              (setq prev-indent (+ prev-indent (eval (car tmp-indent)))))
+             )
+            (setq tmp-indent (cdr tmp-indent)))
+
+          ;; only re-indent if indentation is different then the current
+          (if (= (save-excursion (back-to-indentation) (current-column)) prev-indent)
+              nil
+            (beginning-of-line)
+            (delete-horizontal-space)
+            (indent-to prev-indent))
           ;;
           ;; restore position of point
           ;;
           (goto-char orgpoint)
           (if (< (current-column) (current-indentation))
-              (back-to-indentation)))))
-
-  ;;
-  ;; restore syntax-table
-  ;;
-  (modify-syntax-entry ?_ "_"))
+              (back-to-indentation)))
 
+      ;; restore syntax-table
+      (set-syntax-table previous-syntax-table)
+      (if (featurep 'xemacs)
+          (ad-deactivate 'parse-partial-sexp))
+      )
 
-(defun ada-get-current-indent (prev-indent)
-  ;; Returns the column # to indent the current line to.
-  ;; PREV-INDENT is the indentation resulting from the previous lines.
-  (let ((column nil)
-        (pos nil)
-        (match-cons nil))
+    cur-indent
+    ))
 
+(defun ada-get-current-indent ()
+  "Return the indentation to use for the current line."
+  (let (column
+        pos
+        match-cons
+	result
+        (orgpoint (save-excursion
+                    (beginning-of-line)
+                    (forward-comment -10000)
+                    (forward-line 1)
+                    (point))))
+
+    (setq result
     (cond
-     ;;
+
+     ;;-----------------------------
      ;; in open parenthesis, but not in parameter-list
-     ;;
-     ((and
-       ada-indent-to-open-paren
-       (not (ada-in-paramlist-p))
-       (setq column (ada-in-open-paren-p)))
+     ;;-----------------------------
+
+     ((and ada-indent-to-open-paren
+	   (not (ada-in-paramlist-p))
+	   (setq column (ada-in-open-paren-p)))
+
       ;; check if we have something like this  (Table_Component_Type =>
-      ;;                                          Source_File_Record,)
+      ;;                                          Source_File_Record)
       (save-excursion
-        (if (and (ada-search-ignore-string-comment "[^ \t]" t nil)
-                 (looking-at "\n")
-                 (ada-search-ignore-string-comment "[^ \t\n]" t nil)
-                 (looking-at ">"))
-            (setq column (+ ada-broken-indent column))))
-      column)
 
-     ;;
-     ;; end
-     ;;
-     ((looking-at "\\<end\\>")
-      (save-excursion
-        (ada-goto-matching-start 1)
+	;;  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
+     ;;---------------------------
+
+     ((not (char-after))
+      (ada-indent-on-previous-lines nil orgpoint orgpoint))
+
+     ;;---------------------------
+     ;;  starting with e
+     ;;---------------------------
+
+     ((= (downcase (char-after)) ?e)
+      (cond
 
-        ;;
-        ;; found 'loop' => skip back to 'while' or 'for'
-        ;;                 if 'loop' is not on a separate line
-        ;;
-        (if (and
-             (looking-at "\\<loop\\>")
-             (save-excursion
-               (back-to-indentation)
-               (not (looking-at "\\<loop\\>"))))
-            (if (save-excursion
-                  (and
-                   (setq match-cons
-                         (ada-search-ignore-string-comment
-                          ada-loop-start-re t nil))
-                   (not (looking-at "\\<loop\\>"))))
-                (goto-char (car match-cons))))
+       ;; -------  end  ------
+
+       ((looking-at "end\\>")
+	(let ((label 0)
+	      limit)
+	  (save-excursion
+	    (ada-goto-matching-start 1)
+
+	    ;;
+	    ;; found 'loop' => skip back to 'while' or 'for'
+	    ;;                 if 'loop' is not on a separate line
+	    ;; Stop the search for 'while' and 'for' when a ';' is encountered.
+	    ;;
+	    (if (save-excursion
+		  (beginning-of-line)
+		  (looking-at ".+\\<loop\\>"))
+		(progn
+		  (save-excursion
+		    (setq limit (car (ada-search-ignore-string-comment ";" t))))
+		  (if (save-excursion
+			(and
+			 (setq match-cons
+			      (ada-search-ignore-string-comment ada-loop-start-re t limit))
+			 (not (looking-at "\\<loop\\>"))))
+		      (progn
+			(goto-char (car match-cons))
+			(save-excursion
+			  (beginning-of-line)
+			  (if (looking-at ada-named-block-re)
+			      (setq label (- ada-label-indent))))))))
+
+	    ;; found 'record' =>
+	    ;;  if the keyword is found at the beginning of a line (or just
+	    ;;  after limited, we indent on it, otherwise we indent on the
+	    ;;  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  ----
+
+       ((looking-at "exception\\>")
+	(save-excursion
+	  (ada-goto-matching-start 1)
+	  (list (save-excursion (back-to-indentation) (point)) 0)))
+
+       ;; else
+
+       ((looking-at "else\\>")
+	(if (save-excursion  (ada-goto-previous-word)
+			     (looking-at "\\<or\\>"))
+	    (ada-indent-on-previous-lines nil orgpoint orgpoint)
+	  (save-excursion
+	    (ada-goto-matching-start 1 nil t)
+	    (list (progn (back-to-indentation) (point)) 0))))
+
+       ;; elsif
+
+       ((looking-at "elsif\\>")
+	(save-excursion
+	  (ada-goto-matching-start 1 nil t)
+	  (list (progn (back-to-indentation) (point)) 0)))
 
-        (current-indentation)))
-     ;;
-     ;; exception
-     ;;
-     ((looking-at "\\<exception\\>")
-      (save-excursion
-        (ada-goto-matching-start 1)
-        (current-indentation)))
-     ;;
-     ;; when
-     ;;
-     ((looking-at "\\<when\\>")
-      (save-excursion
-        (ada-goto-matching-start 1)
-        (+ (current-indentation) ada-when-indent)))
-     ;;
-     ;; else
-     ;;
-     ((looking-at "\\<else\\>")
-      (if (save-excursion
-            (ada-goto-previous-word)
-            (looking-at "\\<or\\>"))
-          prev-indent
-        (save-excursion
-          (ada-goto-matching-start 1 nil t)
-          (current-indentation))))
-     ;;
-     ;; elsif
-     ;;
-     ((looking-at "\\<elsif\\>")
+       ))
+
+     ;;---------------------------
+     ;;  starting with w (when)
+     ;;---------------------------
+
+     ((and (= (downcase (char-after)) ?w)
+	   (looking-at "when\\>"))
       (save-excursion
-        (ada-goto-matching-start 1 nil t)
-        (current-indentation)))
-     ;;
-     ;; then
-     ;;
-     ((looking-at "\\<then\\>")
-      (if (save-excursion
-            (ada-goto-previous-word)
-            (looking-at "\\<and\\>"))
-          prev-indent
-        (save-excursion
-          (ada-search-ignore-string-comment "\\<elsif\\>\\|\\<if\\>" t nil)
-          (+ (current-indentation) ada-stmt-end-indent))))
-     ;;
-     ;; loop
-     ;;
-     ((looking-at "\\<loop\\>")
+	(ada-goto-matching-start 1)
+	(list (save-excursion (back-to-indentation) (point))
+	      'ada-when-indent)))
+
+     ;;---------------------------
+     ;;   starting with t (then)
+     ;;---------------------------
+
+     ((and (= (downcase (char-after)) ?t)
+	   (looking-at "then\\>"))
+      (if (save-excursion (ada-goto-previous-word)
+			  (looking-at "and\\>"))
+	  (ada-indent-on-previous-lines nil orgpoint orgpoint)
+	(save-excursion
+	  ;;  Select has been added for the statement: "select ... then abort"
+	  (ada-search-ignore-string-comment
+	   "\\<\\(elsif\\|if\\|select\\)\\>" t nil)
+	  (list (progn (back-to-indentation) (point))
+		'ada-stmt-end-indent))))
+
+     ;;---------------------------
+     ;;   starting with l (loop)
+     ;;---------------------------
+
+     ((and (= (downcase (char-after)) ?l)
+	   (looking-at "loop\\>"))
       (setq pos (point))
       (save-excursion
         (goto-char (match-end 0))
         (ada-goto-stmt-start)
-        (if (looking-at "\\<loop\\>\\|\\<if\\>")
-            prev-indent
-          (progn
-            (if (not (looking-at ada-loop-start-re))
-                (ada-search-ignore-string-comment ada-loop-start-re
-                                                  nil pos))
-            (if (looking-at "\\<loop\\>")
-                prev-indent
-              (+ (current-indentation) ada-stmt-end-indent))))))
-     ;;
-     ;; begin
-     ;;
-     ((looking-at "\\<begin\\>")
+        (if (looking-at "\\<\\(loop\\|if\\)\\>")
+            (ada-indent-on-previous-lines nil orgpoint orgpoint)
+          (unless (looking-at ada-loop-start-re)
+            (ada-search-ignore-string-comment ada-loop-start-re
+                                              nil pos))
+          (if (looking-at "\\<loop\\>")
+              (ada-indent-on-previous-lines nil orgpoint orgpoint)
+            (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent)))))
+
+     ;;----------------------------
+     ;;    starting with l (limited) or r (record)
+     ;;----------------------------
+
+     ((or (and (= (downcase (char-after)) ?l)
+	       (looking-at "limited\\>"))
+	  (and (= (downcase (char-after)) ?r)
+	       (looking-at "record\\>")))
+
+      (save-excursion
+	(ada-search-ignore-string-comment
+	 "\\<\\(type\\|use\\)\\>" t nil)
+	(if (looking-at "\\<use\\>")
+	    (ada-search-ignore-string-comment "for" t nil nil
+					      'word-search-backward))
+	(list (progn (back-to-indentation) (point))
+	      'ada-indent-record-rel-type)))
+
+     ;;---------------------------
+     ;;   starting with b (begin)
+     ;;---------------------------
+
+     ((and (= (downcase (char-after)) ?b)
+	   (looking-at "begin\\>"))
       (save-excursion
         (if (ada-goto-matching-decl-start t)
-            (current-indentation)
-          (progn
-            (message "no matching declaration start")
-            prev-indent))))
-     ;;
-     ;; is
-     ;;
-     ((looking-at "\\<is\\>")
-      (if (and
-           ada-indent-is-separate
-           (save-excursion
-             (goto-char (match-end 0))
-             (ada-goto-next-non-ws (save-excursion
-                                     (end-of-line)
-                                     (point)))
-             (looking-at "\\<abstract\\>\\|\\<separate\\>")))
+            (list (progn (back-to-indentation) (point)) 0)
+          (ada-indent-on-previous-lines nil orgpoint orgpoint))))
+
+     ;;---------------------------
+     ;;   starting with i (is)
+     ;;---------------------------
+
+     ((and (= (downcase (char-after)) ?i)
+	   (looking-at "is\\>"))
+
+      (if (and ada-indent-is-separate
+               (save-excursion
+                 (goto-char (match-end 0))
+                 (ada-goto-next-non-ws (save-excursion (end-of-line)
+                                                       (point)))
+                 (looking-at "\\<abstract\\>\\|\\<separate\\>")))
           (save-excursion
             (ada-goto-stmt-start)
-            (+ (current-indentation) ada-indent))
+            (list (progn (back-to-indentation) (point)) 'ada-indent))
         (save-excursion
           (ada-goto-stmt-start)
-          (+ (current-indentation) ada-stmt-end-indent))))
-     ;;
-     ;; 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))
-        (+ (current-indentation) ada-indent-record-rel-type)))
-     ;;
-     ;; or as statement-start
-     ;;
-     ((ada-looking-at-semi-or)
-      (save-excursion
-        (ada-goto-matching-start 1)
-        (current-indentation)))
-     ;;
-     ;; private as statement-start
-     ;;
-     ((ada-looking-at-semi-private)
+	  (if (looking-at "\\<package\\|procedure\\|function\\>")
+	      (list (progn (back-to-indentation) (point)) 0)
+	    (list (progn (back-to-indentation) (point)) 'ada-indent)))))
+
+     ;;---------------------------
+     ;;  starting with r (return, renames)
+     ;;---------------------------
+
+     ((and (= (downcase (char-after)) ?r)
+	   (looking-at "re\\(turn\\|names\\)\\>"))
+
       (save-excursion
-        (ada-goto-matching-decl-start)
-        (current-indentation)))
-     ;;
-     ;; new/abstract/separate
-     ;;
-     ((looking-at "\\<\\(new\\|abstract\\|separate\\)\\>")
-      (- prev-indent ada-indent (- ada-broken-indent)))
-     ;;
-     ;; return
-     ;;
-     ((looking-at "\\<return\\>")
+	(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'
+     ;;   'or'      as statement-start
+     ;;   'private' as statement-start
+     ;;--------------------------------
+
+     ((and (or (= (downcase (char-after)) ?o)
+	       (= (downcase (char-after)) ?p))
+	   (or (ada-looking-at-semi-or)
+	       (ada-looking-at-semi-private)))
       (save-excursion
-        (forward-sexp -1)
-        (if (and (looking-at "(")
-                 (save-excursion
-                   (backward-sexp 2)
-                   (looking-at "\\<function\\>")))
-            (1+ (current-column))
-          prev-indent)))
-     ;;
-     ;; do
-     ;;
-     ((looking-at "\\<do\\>")
+	;;  ??? Wasn't this done already in ada-looking-at-semi-or ?
+	(ada-goto-matching-start 1)
+	(list (progn (back-to-indentation) (point)) 0)))
+
+     ;;--------------------------------
+     ;;   starting with 'd'  (do)
+     ;;--------------------------------
+
+     ((and (= (downcase (char-after)) ?d)
+	   (looking-at "do\\>"))
       (save-excursion
         (ada-goto-stmt-start)
-        (+ (current-indentation) ada-stmt-end-indent)))
-     ;;
-     ;; package/function/procedure
-     ;;
-     ((and (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")
-           (save-excursion
-             (forward-char 1)
-             (ada-goto-stmt-start)
-             (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")))
-      (save-excursion
-        ;; look for 'generic'
-        (if (and (ada-goto-matching-decl-start t)
-                 (looking-at "generic"))
-            (current-column)
-          prev-indent)))
-     ;;
-     ;; label
-     ;;
-     ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*:[^=]")
-      (if (ada-in-decl-p)
-          prev-indent
-        (+ prev-indent ada-label-indent)))
-     ;;
-     ;; identifier and other noindent-statements
-     ;;
-     ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*")
-      prev-indent)
-     ;;
-     ;; beginning of a parameter list
-     ;;
-     ((looking-at "(")
-      prev-indent)
-     ;;
-     ;; end of a parameter list
-     ;;
-     ((looking-at ")")
-      (save-excursion
-        (forward-char 1)
-        (backward-sexp 1)
-        (current-column)))
-     ;;
-     ;; comment
-     ;;
-     ((looking-at "--")
-      (if ada-indent-comment-as-code
-          prev-indent
-        (current-indentation)))
-     ;;
-     ;; unknown syntax - maybe this should signal an error ?
-     ;;
-     (t
-      prev-indent))))
+        (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent)))
 
+     ;;--------------------------------
+     ;;   starting with '-'  (comment)
+     ;;--------------------------------
 
-(defun ada-indent-function (&optional nomove)
-  ;; Returns the function to calculate the indentation for the current
-  ;; line according to the previous statement, ignoring the contents
-  ;; of the current line after point.  Moves point to the beginning of
-  ;; the current statement, if NOMOVE is nil.
+     ((= (char-after) ?-)
+      (if ada-indent-comment-as-code
 
-  (let ((orgpoint (point))
-        (func nil)
-        (stmt-start nil))
-    ;;
-    ;; inside a parameter-list
-    ;;
-    (if (ada-in-paramlist-p)
-        (setq func 'ada-get-indent-paramlist)
-      (progn
-        ;;
-        ;; move to beginning of current statement
-        ;;
-        (if (not nomove)
-            (setq stmt-start (ada-goto-stmt-start)))
-        ;;
-        ;; no beginning found => don't change indentation
-        ;;
-        (if (and
-             (eq orgpoint (point))
-             (not nomove))
-              (setq func 'ada-get-indent-nochange)
+	  ;;  Indent comments on previous line comments if required
+	  ;;  We must use a search-forward (even if the code is more complex),
+	  ;;  since we want to find the beginning of the comment.
+	  (let (pos)
+
+	    (if (and ada-indent-align-comments
+		     (save-excursion
+		       (forward-line -1)
+		       (beginning-of-line)
+		       (while (and (not pos)
+				   (search-forward "--"
+						    (save-excursion
+						      (end-of-line) (point))
+						    t))
+			 (unless (ada-in-string-p)
+			   (setq pos (point))))
+		       pos))
+		(list (- pos 2) 0)
+
+	    ;;  Else always on previous line
+	    (ada-indent-on-previous-lines nil orgpoint orgpoint)))
+
+	;; Else same indentation as the previous line
+        (list (save-excursion (back-to-indentation) (point)) 0)))
+
+     ;;--------------------------------
+     ;;   starting with '#'  (preprocessor line)
+     ;;--------------------------------
+
+     ((and (= (char-after) ?#)
+	   (equal ada-which-compiler 'gnat)
+           (looking-at "#[ \t]*\\(if\\|els\\(e\\|if\\)\\|end[ \t]*if\\)"))
+      (list (save-excursion (beginning-of-line) (point)) 0))
+
+     ;;--------------------------------
+     ;;   starting with ')' (end of a parameter list)
+     ;;--------------------------------
+
+     ((and (not (eobp)) (= (char-after) ?\)))
+      (save-excursion
+        (forward-char 1)
+        (backward-sexp 1)
+        (list (point) 0)))
 
-          (cond
-           ;;
-           ((and
-             ada-indent-to-open-paren
-             (ada-in-open-paren-p))
-            (setq func 'ada-get-indent-open-paren))
-           ;;
-           ((looking-at "\\<end\\>")
-            (setq func 'ada-get-indent-end))
-           ;;
-           ((looking-at ada-loop-start-re)
-            (setq func 'ada-get-indent-loop))
-           ;;
-           ((looking-at ada-subprog-start-re)
-            (setq func 'ada-get-indent-subprog))
-           ;;
-           ((looking-at "\\<package\\>")
-            (setq func 'ada-get-indent-subprog)) ; maybe it needs a
-                                                 ; special function
-                                                 ; sometimes ?
-           ;;
-           ((looking-at ada-block-start-re)
-            (setq func 'ada-get-indent-block-start))
-           ;;
-           ((looking-at "\\<type\\>")
-            (setq func 'ada-get-indent-type))
-           ;;
-           ((looking-at "\\<if\\>")
-            (setq func 'ada-get-indent-if))
-           ;;
-           ((looking-at "\\<elsif\\>")
-            (setq func 'ada-get-indent-if)) ; maybe it needs a special
-                                            ; function sometimes ?
-           ;;
-           ((looking-at "\\<case\\>")
-            (setq func 'ada-get-indent-case))
-           ;;
-           ((looking-at "\\<when\\>")
-            (setq func 'ada-get-indent-when))
-           ;;
-           ((looking-at "--")
-            (setq func 'ada-get-indent-comment))
-           ;;
-           ((looking-at "[a-zA-Z0-9_]+[ \t\n]*:[^=]")
-            (setq func 'ada-get-indent-label))
-           ;;
-           (t
-            (setq func 'ada-get-indent-noindent))))))
+     ;;---------------------------------
+     ;; new/abstract/separate
+     ;;---------------------------------
 
-    func))
+     ((looking-at "\\(new\\|abstract\\|separate\\)\\>")
+      (ada-indent-on-previous-lines nil orgpoint orgpoint))
 
+     ;;---------------------------------
+     ;; package/function/procedure
+     ;;---------------------------------
 
-;; ---- functions to return indentation for special cases
+     ((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
+	;;  previous subprogram/package
+	(let (found)
+	  (while (and (not found)
+		      (ada-search-ignore-string-comment
+	     "\\<\\(generic\\|end\\|begin\\|package\\|procedure\\|function\\)\\>" t))
+
+	    ;;  avoid "with procedure"... in generic parts
+	    (save-excursion
+	      (forward-word -1)
+	      (setq found (not (looking-at "with"))))))
+
+	(if (looking-at "generic")
+	    (list (progn (back-to-indentation) (point)) 0)
+	  (ada-indent-on-previous-lines nil orgpoint orgpoint))))
+
+     ;;---------------------------------
+     ;; label
+     ;;---------------------------------
 
-(defun ada-get-indent-open-paren (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be behind an open paranthesis not yet closed.
-  (ada-in-open-paren-p))
+     ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
+      (if (ada-in-decl-p)
+          (ada-indent-on-previous-lines nil orgpoint orgpoint)
+        (append (ada-indent-on-previous-lines nil orgpoint orgpoint)
+                '(ada-label-indent))))
+
+     ))
+
+    ;;---------------------------------
+    ;; Other syntaxes
+    ;;---------------------------------
+    (or	result (ada-indent-on-previous-lines nil orgpoint orgpoint))))
+
+(defun ada-indent-on-previous-lines (&optional nomove orgpoint initial-pos)
+  "Calculate the indentation for the new line after ORGPOINT.
+The result list is based on the previous lines in the buffer.
+If NOMOVE is nil, moves point to the beginning of the current statement.
+if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
+  (if initial-pos
+      (goto-char initial-pos))
+  (let ((oldpoint (point)))
+
+    ;; Is inside a parameter-list ?
+    (if (ada-in-paramlist-p)
+        (ada-get-indent-paramlist)
+
+      ;; move to beginning of current statement
+      (unless nomove
+        (ada-goto-stmt-start))
+
+      ;; no beginning found => don't change indentation
+      (if (and (eq oldpoint (point))
+               (not nomove))
+          (ada-get-indent-nochange)
+
+        (cond
+         ;;
+         ((and
+           ada-indent-to-open-paren
+           (ada-in-open-paren-p))
+          (ada-get-indent-open-paren))
+         ;;
+         ((looking-at "end\\>")
+          (ada-get-indent-end orgpoint))
+         ;;
+         ((looking-at ada-loop-start-re)
+          (ada-get-indent-loop orgpoint))
+         ;;
+         ((looking-at ada-subprog-start-re)
+          (ada-get-indent-subprog orgpoint))
+         ;;
+         ((looking-at ada-block-start-re)
+          (ada-get-indent-block-start orgpoint))
+         ;;
+         ((looking-at "\\(sub\\)?type\\>")
+          (ada-get-indent-type orgpoint))
+         ;;
+         ;; "then" has to be included in the case of "select...then abort"
+         ;; statements, since (goto-stmt-start) at the beginning of
+         ;; the current function would leave the cursor on that position
+         ((looking-at "\\(\\(els\\)?if\\>\\)\\|then abort\\\>")
+          (ada-get-indent-if orgpoint))
+         ;;
+         ((looking-at "case\\>")
+          (ada-get-indent-case orgpoint))
+         ;;
+         ((looking-at "when\\>")
+          (ada-get-indent-when orgpoint))
+         ;;
+         ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
+          (ada-get-indent-label orgpoint))
+         ;;
+         ((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
+	  ;;  the previous one ?
+	  (if (save-excursion (search-forward ";" oldpoint t))
+	      (list (progn (back-to-indentation) (point)) 0)
+	    (list (point) (if (looking-at "with")
+			      'ada-with-indent
+			    'ada-use-indent))))
+	 ;;
+         (t
+          (ada-get-indent-noindent orgpoint)))))
+    ))
 
+(defun ada-get-indent-open-paren ()
+  "Calculates the indentation when point is behind an unclosed parenthesis."
+  (list (ada-in-open-paren-p) 0))
 
-(defun ada-get-indent-nochange (orgpoint)
-  ;; Returns the indentation (column #) of the current line.
+(defun ada-get-indent-nochange ()
+  "Return the current indentation of the previous line."
   (save-excursion
     (forward-line -1)
-    (current-indentation)))
-
+    (back-to-indentation)
+    (list (point) 0)))
 
-(defun ada-get-indent-paramlist (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be inside a parameter-list.
+(defun ada-get-indent-paramlist ()
+  "Calculates the indentation when point is inside a parameter list."
   (save-excursion
     (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
     (cond
-     ;;
      ;; in front of the first parameter
-     ;;
-     ((looking-at "(")
+     ((= (char-after) ?\()
       (goto-char (match-end 0))
-      (current-column))
-     ;;
+      (list (point) 0))
+
      ;; in front of another parameter
-     ;;
-     ((looking-at ";")
+     ((= (char-after) ?\;)
       (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
       (ada-goto-next-non-ws)
-      (current-column))
-     ;;
+      (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)
-      (+ (current-column) ada-broken-indent)))))
-
+      (list (point) 0)))))
 
 (defun ada-get-indent-end (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of an end-statement.
-  ;; Therefore it has to find the corresponding start. This can be a little
-  ;; slow, if it has to search through big files with many nested blocks.
-  ;; Signals an error if the corresponding block-start doesn't match.
+  "Calculates the indentation when point is just before an end_statement.
+ORGPOINT is the limit position used in the calculation."
   (let ((defun-name nil)
         (indent nil))
-    ;;
+
     ;; is the line already terminated by ';' ?
-    ;;
     (if (save-excursion
-          (ada-search-ignore-string-comment ";" nil orgpoint))
-        ;;
+          (ada-search-ignore-string-comment ";" nil orgpoint nil
+                                            'search-forward))
+
         ;; yes, look what's following 'end'
-        ;;
         (progn
           (forward-word 1)
           (ada-goto-next-non-ws)
           (cond
+           ((looking-at "\\<\\(loop\\|select\\|if\\|case\\)\\>")
+            (save-excursion (ada-check-matching-start (match-string 0)))
+            (list (save-excursion (back-to-indentation) (point)) 0))
+
            ;;
            ;; loop/select/if/case/record/select
            ;;
-           ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|record\\)\\>")
+           ((looking-at "\\<record\\>")
             (save-excursion
-              (ada-check-matching-start
-               (buffer-substring (match-beginning 0)
-                                 (match-end 0)))
-              (if (looking-at "\\<\\(loop\\|record\\)\\>")
-                  (progn
-                    (forward-word 1)
-                    (ada-goto-stmt-start)))
-              ;; a label ? => skip it
-              (if (looking-at "[a-zA-Z0-9_]+[ \n\t]+:")
-                  (progn
-                    (goto-char (match-end 0))
-                    (ada-goto-next-non-ws)))
-              ;; really looking-at the right thing ?
-              (or (looking-at (concat "\\<\\("
-                                      "loop\\|select\\|if\\|case\\|"
-                                      "record\\|while\\|type\\)\\>"))
-                  (progn
-                    (ada-search-ignore-string-comment
-                     (concat "\\<\\("
-                             "loop\\|select\\|if\\|case\\|"
-                             "record\\|while\\|type\\)\\>")))
-                  (backward-word 1))
-              (current-indentation)))
+              (ada-check-matching-start (match-string 0))
+              ;;  we are now looking at the matching "record" statement
+              (forward-word 1)
+              (ada-goto-stmt-start)
+              ;;  now on the matching type declaration, or use clause
+              (unless (looking-at "\\(for\\|type\\)\\>")
+                (ada-search-ignore-string-comment "\\<type\\>" t))
+              (list (progn (back-to-indentation) (point)) 0)))
            ;;
            ;; a named block end
            ;;
-           ((looking-at "[a-zA-Z0-9_]+")
-            (setq defun-name (buffer-substring (match-beginning 0)
-                                               (match-end 0)))
+           ((looking-at ada-ident-re)
+            (setq defun-name (match-string 0))
             (save-excursion
               (ada-goto-matching-start 0)
-              (ada-check-defun-name defun-name)
-              (current-indentation)))
+              (ada-check-defun-name defun-name))
+            (list (progn (back-to-indentation) (point)) 0))
            ;;
            ;; a block-end without name
            ;;
-           ((looking-at ";")
+           ((= (char-after) ?\;)
             (save-excursion
               (ada-goto-matching-start 0)
               (if (looking-at "\\<begin\\>")
                   (progn
-                    (setq indent (current-column))
+                    (setq indent (list (point) 0))
                     (if (ada-goto-matching-decl-start t)
-                        (current-indentation)
-                      indent)))))
+                        (list (progn (back-to-indentation) (point)) 0)
+                      indent))
+		(list (progn (back-to-indentation) (point)) 0)
+		)))
            ;;
            ;; anything else - should maybe signal an error ?
            ;;
            (t
-            (+ (current-indentation) ada-broken-indent))))
-
-      (+ (current-indentation) ada-broken-indent))))
+            (list (save-excursion (back-to-indentation) (point))
+                  'ada-broken-indent))))
 
+      (list (save-excursion (back-to-indentation) (point))
+            'ada-broken-indent))))
 
 (defun ada-get-indent-case (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of an case-statement.
-  (let ((cur-indent (current-indentation))
-        (match-cons nil)
+  "Calculates the indentation when point is just before a case statement.
+ORGPOINT is the limit position used in the calculation."
+  (let ((match-cons nil)
         (opos (point)))
     (cond
      ;;
      ;; case..is..when..=>
      ;;
      ((save-excursion
-       (setq match-cons (ada-search-ignore-string-comment
-                         "[ \t\n]+=>" nil orgpoint)))
+        (setq match-cons (and
+                          ;; the `=>' must be after the keyword `is'.
+                          (ada-search-ignore-string-comment
+                           "is" nil orgpoint nil 'word-search-forward)
+                          (ada-search-ignore-string-comment
+                           "[ \t\n]+=>" nil orgpoint))))
       (save-excursion
         (goto-char (car match-cons))
-        (if (not (ada-search-ignore-string-comment "\\<when\\>" t opos))
-            (error "missing 'when' between 'case' and '=>'"))
-        (+ (current-indentation) ada-indent)))
+        (unless (ada-search-ignore-string-comment "when" t opos)
+          (error "missing 'when' between 'case' and '=>'"))
+        (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))
      ;;
      ;; case..is..when
      ;;
      ((save-excursion
-       (setq match-cons (ada-search-ignore-string-comment
-                         "\\<when\\>" nil orgpoint)))
+        (setq match-cons (ada-search-ignore-string-comment
+                          "when" nil orgpoint nil 'word-search-forward)))
       (goto-char (cdr match-cons))
-      (+ (current-indentation) ada-broken-indent))
+      (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
      ;;
      ;; case..is
      ;;
      ((save-excursion
-       (setq match-cons (ada-search-ignore-string-comment
-                         "\\<is\\>" nil orgpoint)))
-      (+ (current-indentation) ada-when-indent))
+        (setq match-cons (ada-search-ignore-string-comment
+                          "is" nil orgpoint nil 'word-search-forward)))
+      (list (save-excursion (back-to-indentation) (point)) 'ada-when-indent))
      ;;
      ;; incomplete case
      ;;
      (t
-      (+ (current-indentation) ada-broken-indent)))))
-
+      (list (save-excursion (back-to-indentation) (point))
+            'ada-broken-indent)))))
 
 (defun ada-get-indent-when (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of an when-statement.
-  (let ((cur-indent (current-indentation)))
-    (if (ada-search-ignore-string-comment
-         "[ \t\n]+=>" nil orgpoint)
-        (+ cur-indent  ada-indent)
-      (+ cur-indent ada-broken-indent))))
-
+  "Calculates the indentation when point is just before a when statement.
+ORGPOINT is the limit position used in the calculation."
+  (let ((cur-indent (save-excursion (back-to-indentation) (point))))
+    (if (ada-search-ignore-string-comment "[ \t\n]*=>" nil orgpoint)
+        (list cur-indent 'ada-indent)
+      (list cur-indent 'ada-broken-indent))))
 
 (defun ada-get-indent-if (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of an if-statement.
-  (let ((cur-indent (current-indentation))
+  "Calculates the indentation when point is just before an if statement.
+ORGPOINT is the limit position used in the calculation."
+  (let ((cur-indent (save-excursion (back-to-indentation) (point)))
         (match-cons nil))
     ;;
-    ;; if..then ?
+    ;; Move to the correct then (ignore all "and then")
     ;;
-    (if (ada-search-but-not
-         "\\<then\\>" "\\<and\\>[ \t\n]+\\<then\\>" nil orgpoint)
-
+    (while (and (setq match-cons (ada-search-ignore-string-comment
+                                  "\\<\\(then\\|and[ \t]*then\\)\\>"
+                                  nil orgpoint))
+                (= (downcase (char-after (car match-cons))) ?a)))
+    ;; If "then" was found (we are looking at it)
+    (if match-cons
         (progn
           ;;
           ;; 'then' first in separate line ?
-          ;; => indent according to 'then'
+          ;; => indent according to 'then',
+          ;; => else indent according to 'if'
           ;;
           (if (save-excursion
                 (back-to-indentation)
                 (looking-at "\\<then\\>"))
-              (setq cur-indent (current-indentation)))
+              (setq cur-indent (save-excursion (back-to-indentation) (point))))
+          ;; skip 'then'
           (forward-word 1)
-          ;;
-          ;; something follows 'then' ?
-          ;;
-          (if (setq match-cons
-                    (ada-search-ignore-string-comment
-                     "[^ \t\n]" nil orgpoint))
-              (progn
-                (goto-char (car match-cons))
-                (+ ada-indent
-                   (- cur-indent (current-indentation))
-                   (funcall (ada-indent-function t) orgpoint)))
-
-            (+ cur-indent ada-indent)))
-
-      (+ cur-indent ada-broken-indent))))
+          (list cur-indent 'ada-indent))
 
+      (list cur-indent 'ada-broken-indent))))
 
 (defun ada-get-indent-block-start (orgpoint)
-  ;; Returns the indentation (column #) for the new line after
-  ;; ORGPOINT.  Assumes point to be at the beginning of a block start
-  ;; keyword.
-  (let ((cur-indent (current-indentation))
-        (pos nil))
+  "Calculates the indentation when point is at the start of a block.
+ORGPOINT is the limit position used in the calculation."
+  (let ((pos nil))
     (cond
      ((save-excursion
         (forward-word 1)
-        (setq pos (car (ada-search-ignore-string-comment
-                        "[^ \t\n]" nil orgpoint))))
+        (setq pos (ada-goto-next-non-ws orgpoint)))
       (goto-char pos)
       (save-excursion
-        (funcall (ada-indent-function t) orgpoint)))
-     ;;
+        (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
-      (+ (current-indentation) ada-indent)))))
-
+      (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))
 
 (defun ada-get-indent-subprog (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of a subprog-/package-declaration.
+  "Calculates the indentation when point is just before a subprogram.
+ORGPOINT is the limit position used in the calculation."
   (let ((match-cons nil)
-        (cur-indent (current-indentation))
-        (foundis nil)
-        (addind 0)
-        (fstart (point)))
+        (cur-indent (save-excursion (back-to-indentation) (point)))
+        (foundis nil))
     ;;
     ;; is there an 'is' in front of point ?
     ;;
     (if (save-excursion
           (setq match-cons
-                (ada-search-ignore-string-comment
-                 "\\<is\\>\\|\\<do\\>" nil orgpoint)))
+               (ada-search-ignore-string-comment
+                "\\<\\(is\\|do\\)\\>" nil orgpoint)))
         ;;
         ;; yes, then skip to its end
         ;;
@@ -2066,8 +3033,7 @@ This works by two steps:
       ;; no, then goto next non-ws, if there is one in front of point
       ;;
       (progn
-        (if (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)
-            (ada-goto-next-non-ws)
+        (unless (ada-goto-next-non-ws orgpoint)
           (goto-char orgpoint))))
 
     (cond
@@ -2079,7 +3045,7 @@ This works by two steps:
        (save-excursion
          (not (ada-search-ignore-string-comment
                "[^ \t\n]" nil orgpoint t))))
-      (+ cur-indent ada-indent))
+      (list cur-indent 'ada-indent))
      ;;
      ;; is abstract/separate/new ...
      ;;
@@ -2087,114 +3053,148 @@ This works by two steps:
        foundis
        (save-excursion
          (setq match-cons
-               (ada-search-ignore-string-comment
-                "\\<\\(separate\\|new\\|abstract\\)\\>"
-                nil orgpoint))))
+              (ada-search-ignore-string-comment
+               "\\<\\(separate\\|new\\|abstract\\)\\>"
+               nil orgpoint))))
       (goto-char (car match-cons))
-      (ada-search-ignore-string-comment (concat ada-subprog-start-re
-                                                "\\|\\<package\\>") t)
+      (ada-search-ignore-string-comment ada-subprog-start-re t)
       (ada-get-indent-noindent orgpoint))
      ;;
      ;; something follows 'is'
      ;;
      ((and
        foundis
-       (save-excursion
-         (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))
-       (ada-goto-next-non-ws)
-      (funcall (ada-indent-function t) orgpoint)))
+       (save-excursion (setq match-cons (ada-goto-next-non-ws orgpoint)))
+       (goto-char match-cons)
+       (ada-indent-on-previous-lines t orgpoint)))
      ;;
      ;; no 'is' but ';'
      ;;
      ((save-excursion
-        (ada-search-ignore-string-comment ";" nil orgpoint))
-      cur-indent)
+        (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward))
+      (list cur-indent 0))
      ;;
      ;; no 'is' or ';'
      ;;
      (t
-      (+ cur-indent ada-broken-indent)))))
-
+      (list cur-indent 'ada-broken-indent)))))
 
 (defun ada-get-indent-noindent (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of a 'noindent statement'.
-  (if (save-excursion
-        (ada-search-ignore-string-comment ";" nil orgpoint))
-      (current-indentation)
-    (+ (current-indentation) ada-broken-indent)))
+  "Calculates the indentation when point is just before a 'noindent stmt'.
+ORGPOINT is the limit position used in the calculation."
+  (let ((label 0))
+    (save-excursion
+      (beginning-of-line)
+
+      (cond
 
+       ;;  This one is called when indenting a line preceded by a multi-line
+       ;;  subprogram declaration (in that case, we are at this point inside
+       ;;  the parameter declaration list)
+       ((ada-in-paramlist-p)
+        (ada-previous-procedure)
+        (list (save-excursion (back-to-indentation) (point)) 0))
+
+       ;;  This one is called when indenting the second line of a multi-line
+       ;;  declaration section, in a declare block or a record declaration
+       ((looking-at "[ \t]*\\(\\sw\\|_\\)*[ \t]*,[ \t]*$")
+        (list (save-excursion (back-to-indentation) (point))
+              'ada-broken-decl-indent))
+
+       ;;  This one is called in every over case when indenting a line at the
+       ;;  top level
+       (t
+        (if (looking-at ada-named-block-re)
+            (setq label (- ada-label-indent))
+
+          (let (p)
+
+            ;;  "with private" or "null record" cases
+            (if (or (save-excursion
+                      (and (ada-search-ignore-string-comment "\\<private\\>" nil orgpoint)
+                           (setq p (point))
+                           (save-excursion (forward-char -7);; skip back "private"
+                                           (ada-goto-previous-word)
+                                           (looking-at "with"))))
+                    (save-excursion
+                      (and (ada-search-ignore-string-comment "\\<record\\>" nil orgpoint)
+                           (setq p (point))
+                           (save-excursion (forward-char -6);; skip back "record"
+                                           (ada-goto-previous-word)
+                                           (looking-at "null")))))
+                (progn
+                  (goto-char p)
+                  (re-search-backward "\\<\\(type\\|subtype\\)\\>" nil t)
+                  (list (save-excursion (back-to-indentation) (point)) 0)))))
+        (if (save-excursion
+              (ada-search-ignore-string-comment ";" nil orgpoint nil
+                                                'search-forward))
+            (list (+ (save-excursion (back-to-indentation) (point)) label) 0)
+          (list (+ (save-excursion (back-to-indentation) (point)) label)
+                'ada-broken-indent)))))))
 
 (defun ada-get-indent-label (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of a label or variable declaration.
-  ;; Checks the context to decide if it's a label or a variable declaration.
-  ;; This check might be a bit slow.
+  "Calculates the indentation when before a label or variable declaration.
+ORGPOINT is the limit position used in the calculation."
   (let ((match-cons nil)
-        (cur-indent (current-indentation)))
-    (goto-char (cdr (ada-search-ignore-string-comment ":")))
+        (cur-indent (save-excursion (back-to-indentation) (point))))
+    (ada-search-ignore-string-comment ":" nil)
     (cond
-     ;;
      ;; loop label
-     ;;
      ((save-excursion
         (setq match-cons (ada-search-ignore-string-comment
                           ada-loop-start-re nil orgpoint)))
       (goto-char (car match-cons))
       (ada-get-indent-loop orgpoint))
-     ;;
+
      ;; declare label
-     ;;
      ((save-excursion
         (setq match-cons (ada-search-ignore-string-comment
-                          "\\<declare\\>" nil orgpoint)))
-      (save-excursion
-        (goto-char (car match-cons))
-        (+ (current-indentation) ada-indent)))
-     ;;
-     ;; complete statement following colon
-     ;;
-     ((save-excursion
-        (ada-search-ignore-string-comment ";" nil orgpoint))
-      (if (ada-in-decl-p)
-          cur-indent                      ; variable-declaration
-        (- cur-indent ada-label-indent))) ; label
-     ;;
-     ;; broken statement
-     ;;
-     ((save-excursion
-        (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))
-      (if (ada-in-decl-p)
-          (+ cur-indent ada-broken-indent)
-        (+ cur-indent ada-broken-indent (- ada-label-indent))))
-     ;;
+                          "\\<declare\\|begin\\>" nil orgpoint)))
+      (goto-char (car match-cons))
+      (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
+
+     ;; variable declaration
+     ((ada-in-decl-p)
+      (if (save-excursion
+            (ada-search-ignore-string-comment ";" nil orgpoint))
+          (list cur-indent 0)
+        (list cur-indent 'ada-broken-indent)))
+
      ;; nothing follows colon
-     ;;
      (t
-      (if (ada-in-decl-p)
-          (+ cur-indent ada-broken-indent)   ; variable-declaration
-        (- cur-indent ada-label-indent)))))) ; label
-
+      (list cur-indent '(- ada-label-indent))))))
 
 (defun ada-get-indent-loop (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of a loop statement
-  ;; or (unfortunately) also a for ... use statement.
+  "Calculates the indentation when just before a loop or a for ... use.
+ORGPOINT is the limit position used in the calculation."
   (let ((match-cons nil)
-        (pos (point)))
+        (pos (point))
+
+        ;; If looking at a named block, skip the label
+        (label (save-excursion
+                 (beginning-of-line)
+                 (if (looking-at ada-named-block-re)
+                     (- ada-label-indent)
+                   0))))
+
     (cond
 
      ;;
      ;; statement complete
      ;;
      ((save-excursion
-        (ada-search-ignore-string-comment ";" nil orgpoint))
-      (current-indentation))
+        (ada-search-ignore-string-comment ";" nil orgpoint nil
+                                          'search-forward))
+      (list (+ (save-excursion (back-to-indentation) (point)) label) 0))
      ;;
      ;; simple loop
      ;;
      ((looking-at "loop\\>")
-      (ada-get-indent-block-start orgpoint))
+      (setq pos (ada-get-indent-block-start orgpoint))
+      (if (equal label 0)
+          pos
+        (list (+ (car pos) label) (cdr pos))))
 
      ;;
      ;; 'for'- loop (or also a for ... use statement)
@@ -2207,43 +3207,48 @@ This works by two steps:
        ((save-excursion
           (and
            (goto-char (match-end 0))
-           (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint)
-           (not (backward-char 1))
-           (not (zerop (skip-chars-forward "_a-zA-Z0-9'")))
-           (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint)
-           (not (backward-char 1))
+           (ada-goto-next-non-ws orgpoint)
+           (forward-word 1)
+           (if (= (char-after) ?') (forward-word 1) t)
+           (ada-goto-next-non-ws orgpoint)
            (looking-at "\\<use\\>")
            ;;
            ;; check if there is a 'record' before point
            ;;
            (progn
              (setq match-cons (ada-search-ignore-string-comment
-                               "\\<record\\>" nil orgpoint))
+                               "record" nil orgpoint nil 'word-search-forward))
              t)))
         (if match-cons
-            (goto-char (car match-cons)))
-        (+ (current-indentation) 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
        ;;
        ((save-excursion
           (setq match-cons (ada-search-ignore-string-comment
-                            "\\<loop\\>" nil orgpoint)))
+                            "loop" nil orgpoint nil 'word-search-forward)))
         (goto-char (car match-cons))
         ;;
         ;; indent according to 'loop', if it's first in the line;
         ;; otherwise to 'for'
         ;;
-        (if (not (save-excursion
-                   (back-to-indentation)
-                   (looking-at "\\<loop\\>")))
-            (goto-char pos))
-        (+ (current-indentation) ada-indent))
+        (unless (save-excursion
+                  (back-to-indentation)
+                  (looking-at "\\<loop\\>"))
+          (goto-char pos))
+        (list (+ (save-excursion (back-to-indentation) (point)) label)
+              'ada-indent))
        ;;
        ;; for-statement is broken
        ;;
        (t
-        (+ (current-indentation) ada-broken-indent))))
+        (list (+ (save-excursion (back-to-indentation) (point)) label)
+              'ada-broken-indent))))
 
      ;;
      ;; 'while'-loop
@@ -2254,7 +3259,7 @@ This works by two steps:
       ;;
       (if (save-excursion
             (setq match-cons (ada-search-ignore-string-comment
-                              "\\<loop\\>" nil orgpoint)))
+                              "loop" nil orgpoint nil 'word-search-forward)))
 
           (progn
             (goto-char (car match-cons))
@@ -2262,18 +3267,19 @@ This works by two steps:
             ;; indent according to 'loop', if it's first in the line;
             ;; otherwise to 'while'.
             ;;
-            (if (not (save-excursion
-                       (back-to-indentation)
-                       (looking-at "\\<loop\\>")))
-                (goto-char pos))
-            (+ (current-indentation) ada-indent))
-
-        (+ (current-indentation) ada-broken-indent))))))
+            (unless (save-excursion
+                      (back-to-indentation)
+                      (looking-at "\\<loop\\>"))
+              (goto-char pos))
+            (list (+ (save-excursion (back-to-indentation) (point)) label)
+                  'ada-indent))
 
+        (list (+ (save-excursion (back-to-indentation) (point)) label)
+              'ada-broken-indent))))))
 
 (defun ada-get-indent-type (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of a type statement.
+  "Calculates the indentation when before a type statement.
+ORGPOINT is the limit position used in the calculation."
   (let ((match-dat nil))
     (cond
      ;;
@@ -2281,132 +3287,142 @@ This works by two steps:
      ;;
      ((save-excursion
         (and
-         (setq match-dat (ada-search-ignore-string-comment "\\<end\\>"
-                                                           nil
-                                                           orgpoint))
+         (setq match-dat (ada-search-ignore-string-comment
+                          "end" nil orgpoint nil 'word-search-forward))
          (ada-goto-next-non-ws)
          (looking-at "\\<record\\>")
          (forward-word 1)
          (ada-goto-next-non-ws)
-         (looking-at ";")))
+         (= (char-after) ?\;)))
       (goto-char (car match-dat))
-      (current-indentation))
+      (list (save-excursion (back-to-indentation) (point)) 0))
      ;;
      ;; record type
      ;;
      ((save-excursion
-        (setq match-dat (ada-search-ignore-string-comment "\\<record\\>"
-                                                          nil
-                                                          orgpoint)))
+        (setq match-dat (ada-search-ignore-string-comment
+                         "record" nil orgpoint nil 'word-search-forward)))
       (goto-char (car match-dat))
-      (+ (current-indentation) ada-indent))
+      (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
      ;;
      ;; complete type declaration
      ;;
      ((save-excursion
-        (ada-search-ignore-string-comment ";" nil orgpoint))
-      (current-indentation))
+        (ada-search-ignore-string-comment ";" nil orgpoint nil
+                                          'search-forward))
+      (list (save-excursion (back-to-indentation) (point)) 0))
      ;;
-     ;; type ... is
+     ;; "type ... is", but not "type ... is ...", which is broken
      ;;
      ((save-excursion
-        (ada-search-ignore-string-comment "\\<is\\>" nil orgpoint))
-      (+ (current-indentation) ada-indent))
+        (and
+         (ada-search-ignore-string-comment "is" nil orgpoint nil
+                                           'word-search-forward)
+         (not (ada-goto-next-non-ws orgpoint))))
+      (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
      ;;
      ;; broken statement
      ;;
      (t
-      (+ (current-indentation) ada-broken-indent)))))
+      (list (save-excursion (back-to-indentation) (point))
+            'ada-broken-indent)))))
 
 
-;;; ---- support-functions for indentation
-
-;;; ---- searching and matching
-
-(defun ada-goto-stmt-start (&optional limit)
-  ;; Moves point to the beginning of the statement that point is in or
-  ;; after.  Returns the new position of point.  Beginnings are found
-  ;; by searching for 'ada-end-stmt-re' and then moving to the
-  ;; following non-ws that is not a comment.  LIMIT is actually not
-  ;; used by the indentation functions.
+;; -----------------------------------------------------------
+;; -- searching and matching
+;; -----------------------------------------------------------
+
+(defun ada-goto-stmt-start ()
+  "Moves point to the beginning of the statement that point is in or after.
+Returns the new position of point.
+As a special case, if we are looking at a closing parenthesis, skip to the
+open parenthesis."
   (let ((match-dat nil)
         (orgpoint (point)))
 
-    (setq match-dat (ada-search-prev-end-stmt limit))
+    (setq match-dat (ada-search-prev-end-stmt))
     (if match-dat
-        ;;
-        ;; found a previous end-statement => check if anything follows
-        ;;
-        (progn
-          (if (not
-               (save-excursion
-                 (goto-char (cdr match-dat))
-                 (ada-search-ignore-string-comment
-                  "[^ \t\n]" nil orgpoint)))
-              ;;
-              ;; nothing follows => it's the end-statement directly in
-              ;;                    front of point => search again
-              ;;
-              (setq match-dat (ada-search-prev-end-stmt limit)))
-          ;;
-          ;; if found the correct end-stetement => goto next non-ws
-          ;;
-          (if match-dat
-              (goto-char (cdr match-dat)))
-          (ada-goto-next-non-ws))
+
+	;;
+	;; found a previous end-statement => check if anything follows
+	;;
+	(unless (looking-at "declare")
+	  (progn
+	    (unless (save-excursion
+		      (goto-char (cdr match-dat))
+		      (ada-goto-next-non-ws orgpoint))
+	      ;;
+	      ;; nothing follows => it's the end-statement directly in
+	      ;;                    front of point => search again
+	      ;;
+	      (setq match-dat (ada-search-prev-end-stmt)))
+	    ;;
+	    ;; if found the correct end-statement => goto next non-ws
+	    ;;
+	    (if match-dat
+		(goto-char (cdr match-dat)))
+	    (ada-goto-next-non-ws)
+	    ))
 
       ;;
       ;; no previous end-statement => we are at the beginning of the
       ;;                              accessible part of the buffer
       ;;
       (progn
-        (goto-char (point-min))
-        ;;
-        ;; skip to the very first statement, if there is one
-        ;;
-        (if (setq match-dat
-                  (ada-search-ignore-string-comment
-                   "[^ \t\n]" nil orgpoint))
-            (goto-char (car match-dat))
-          (goto-char orgpoint))))
-
-
+	(goto-char (point-min))
+	;;
+	;; skip to the very first statement, if there is one
+	  ;;
+	(unless (ada-goto-next-non-ws orgpoint)
+	  (goto-char orgpoint))))
     (point)))
 
 
-(defun ada-search-prev-end-stmt (&optional limit)
-  ;; Moves point to previous end-statement.  Returns a cons cell whose
-  ;; car is the beginning and whose cdr the end of the match.
-  ;; End-statements are defined by 'ada-end-stmt-re'.  Checks for
-  ;; certain keywords if they follow 'end', which means they are no
-  ;; end-statement there.
+(defun ada-search-prev-end-stmt ()
+  "Moves point to previous end-statement.
+Returns a cons cell whose car is the beginning and whose cdr the end of the
+match."
   (let ((match-dat nil)
-        (pos nil)
         (found nil))
-    ;;
+
     ;; search until found or beginning-of-buffer
-    ;;
     (while
         (and
          (not found)
-         (setq match-dat (ada-search-ignore-string-comment ada-end-stmt-re
-                                                           t
-                                                           limit)))
+         (setq match-dat (ada-search-ignore-string-comment
+                          ada-end-stmt-re t)))
 
       (goto-char (car match-dat))
-
-      (if (not (ada-in-open-paren-p))
-          ;;
-          ;; check if there is an 'end' in front of the match
-          ;;
-          (if (not (and
-                    (looking-at "\\<\\(record\\|loop\\|select\\)\\>")
-                    (save-excursion
-                      (ada-goto-previous-word)
-                      (looking-at "\\<end\\>"))))
-              (setq found t)
-
-            (backward-word 1)))) ; end of loop
+      (unless (ada-in-open-paren-p)
+	(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
@@ -2414,121 +3430,147 @@ This works by two steps:
 
 
 (defun ada-goto-next-non-ws (&optional limit)
-  ;; Skips whitespaces, newlines and comments to next non-ws
-  ;; character.  Signals an error if there is no more such character
-  ;; and limit is nil.
-  (let ((match-cons nil))
-    (setq match-cons (ada-search-ignore-string-comment
-                      "[^ \t\n]" nil limit t))
-    (if match-cons
-        (goto-char (car match-cons))
-      (if (not limit)
-          (error "no more non-ws")
-        nil))))
+  "Skips white spaces, newlines and comments to next non-ws character.
+Stop the search at LIMIT.
+Do not call this function from within a string."
+  (unless limit
+    (setq limit (point-max)))
+  (while (and (<= (point) limit)
+              (progn (forward-comment 10000)
+                     (if (and (not (eobp))
+                              (save-excursion (forward-char 1)
+                                              (ada-in-string-p)))
+                         (progn (forward-sexp 1) t)))))
+  (if (< (point) limit)
+      (point)
+    nil)
+  )
 
 
 (defun ada-goto-stmt-end (&optional limit)
-  ;; Moves point to the end of the statement that point is in or
-  ;; before.  Returns the new position of point or nil if not found.
+  "Moves point to the end of the statement that point is in or before.
+Returns the new position of point or nil if not found.
+Stop the search at LIMIT."
   (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit)
       (point)
     nil))
 
 
-(defun ada-goto-previous-word ()
-  ;; Moves point to the beginning of the previous word of ada-code.
-  ;; Returns the new position of point or nil if not found.
+(defun ada-goto-next-word (&optional backward)
+  "Moves point to the beginning of the next word of Ada code.
+If BACKWARD is non-nil, jump to the beginning of the previous word.
+Returns the new position of point or nil if not found."
   (let ((match-cons nil)
-        (orgpoint (point)))
+        (orgpoint (point))
+        (old-syntax (char-to-string (char-syntax ?_))))
+    (modify-syntax-entry ?_ "w")
+    (unless backward
+      (skip-syntax-forward "w"))
     (if (setq match-cons
-              (ada-search-ignore-string-comment "[^ \t\n]" t nil t))
+             (if backward
+                 (ada-search-ignore-string-comment "\\w" t nil t)
+               (ada-search-ignore-string-comment "\\w" nil nil t)))
         ;;
         ;; move to the beginning of the word found
         ;;
         (progn
-          (goto-char (cdr match-cons))
-          (skip-chars-backward "_a-zA-Z0-9")
+          (goto-char (car match-cons))
+          (skip-syntax-backward "w")
           (point))
       ;;
       ;; if not found, restore old position of point
       ;;
-      (progn
-        (goto-char orgpoint)
-        'nil))))
+      (goto-char orgpoint)
+      'nil)
+    (modify-syntax-entry ?_ old-syntax))
+  )
 
 
 (defun ada-check-matching-start (keyword)
-  ;; Signals an error if matching block start is not KEYWORD.
-  ;; Moves point to the matching block start.
+  "Signals an error if matching block start is not KEYWORD.
+Moves point to the matching block start."
   (ada-goto-matching-start 0)
-  (if (not (looking-at (concat "\\<" keyword "\\>")))
-      (error (concat
-              "matching start is not '"
-              keyword "'"))))
+  (unless (looking-at (concat "\\<" keyword "\\>"))
+    (error "matching start is not '%s'" keyword)))
 
 
 (defun ada-check-defun-name (defun-name)
-  ;; Checks if the name of the matching defun really is DEFUN-NAME.
-  ;; Assumes point to be already positioned by 'ada-goto-matching-start'.
-  ;; Moves point to the beginning of the declaration.
-
-  ;;
-  ;; 'accept' or 'package' ?
-  ;;
-  (if (not (looking-at "\\<\\(accept\\|package\\|task\\)\\>"))
+  "Checks if the name of the matching defun really is DEFUN-NAME.
+Assumes point to be already positioned by 'ada-goto-matching-start'.
+Moves point to the beginning of the declaration."
+
+  ;; named block without a `declare'
+  (if (save-excursion
+        (ada-goto-previous-word)
+        (looking-at (concat "\\<" defun-name "\\> *:")))
+      t                                 ; do nothing
+    ;;
+    ;; 'accept' or 'package' ?
+    ;;
+    (unless (looking-at ada-subprog-start-re)
       (ada-goto-matching-decl-start))
-  ;;
-  ;; 'begin' of 'procedure'/'function'/'task' or 'declare'
-  ;;
-  (save-excursion
     ;;
-    ;; a named 'declare'-block ?
+    ;; 'begin' of 'procedure'/'function'/'task' or 'declare'
     ;;
-    (if (looking-at "\\<declare\\>")
-        (ada-goto-stmt-start)
+    (save-excursion
       ;;
-      ;; no, => 'procedure'/'function'/'task'
+      ;; a named 'declare'-block ?
       ;;
-      (progn
-        (forward-word 2)
-        (backward-word 1)
+      (if (looking-at "\\<declare\\>")
+          (ada-goto-stmt-start)
         ;;
-        ;; skip 'body' or 'type'
+        ;; no, => 'procedure'/'function'/'task'/'protected'
         ;;
-        (if (looking-at "\\<\\(body\\|type\\)\\>")
-            (forward-word 1))
-        (forward-sexp 1)
-        (backward-sexp 1)))
-    ;;
-    ;; should be looking-at the correct name
-    ;;
-    (if (not (looking-at (concat "\\<" defun-name "\\>")))
-        (error
-         (concat
-          "matching defun has different name: "
-          (buffer-substring
-           (point)
-           (progn
-             (forward-sexp 1)
-             (point))))))))
+        (progn
+          (forward-word 2)
+          (backward-word 1)
+          ;;
+          ;; skip 'body' 'type'
+          ;;
+          (if (looking-at "\\<\\(body\\|type\\)\\>")
+              (forward-word 1))
+          (forward-sexp 1)
+          (backward-sexp 1)))
+      ;;
+      ;; should be looking-at the correct name
+      ;;
+      (unless (looking-at (concat "\\<" defun-name "\\>"))
+        (error "matching defun has different name: %s"
+               (buffer-substring (point)
+                                 (progn (forward-sexp 1) (point))))))))
+
+(defun ada-goto-matching-decl-start (&optional noerror recursive)
+  "Moves point to the matching declaration start of the current 'begin'.
+If NOERROR is non-nil, it only returns nil if no match was found."
+  (let ((nest-count 1)
 
+	;;  first should be set to t if we should stop at the first
+	;;  "begin" we encounter.
+        (first (not recursive))
+        (count-generic nil)
+	(stop-at-when nil)
+        )
+
+    ;;  Ignore "when" most of the time, except if we are looking at the
+    ;;  beginning of a block (structure:  case .. is
+    ;;                                    when ... =>
+    ;;                                       begin ...
+    ;;                                       exception ... )
+    (if (looking-at "begin")
+        (setq stop-at-when t))
+
+    (if (or
+         (looking-at "\\<\\(package\\|procedure\\|function\\)\\>")
+         (save-excursion
+           (ada-search-ignore-string-comment
+            "\\<\\(package\\|procedure\\|function\\|generic\\)\\>" t)
+           (looking-at "generic")))
+        (setq count-generic t))
 
-(defun ada-goto-matching-decl-start (&optional noerror nogeneric)
-  ;; 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)
-        (pos nil)
-        (first t)
-        (flag nil))
-    ;;
     ;; search backward for interesting keywords
-    ;;
     (while (and
             (not (zerop nest-count))
-            (ada-search-ignore-string-comment
-             (concat "\\<\\("
-                     "is\\|separate\\|end\\|declare\\|new\\|begin\\|generic"
-                     "\\)\\>") t))
+            (ada-search-ignore-string-comment ada-matching-decl-start-re t))
       ;;
       ;; calculate nest-depth
       ;;
@@ -2536,29 +3578,83 @@ This works by two steps:
        ;;
        ((looking-at "end")
         (ada-goto-matching-start 1 noerror)
-        (if (progn
-              (looking-at "begin"))
-            (setq nest-count (1+ nest-count))))
+
+        ;;  In some case, two begin..end block can follow each other closely,
+        ;;  which we have to detect, as in
+        ;;     procedure P is
+        ;;        procedure Q is
+        ;;        begin
+        ;;        end;
+        ;;     begin    --  here we should go to procedure, not begin
+        ;;     end
+
+        (if (looking-at "begin")
+            (let ((loop-again t))
+              (save-excursion
+                (while loop-again
+                  ;;  If begin was just there as the beginning of a block
+                  ;;  (with no declare) then do nothing, otherwise just
+                  ;;  register that we have to find the statement that
+                  ;;  required the begin
+
+                  (ada-search-ignore-string-comment
+                   "\\<\\(declare\\|begin\\|end\\|procedure\\|function\\|task\\|package\\)\\>"
+                   t)
+
+                  (if (looking-at "end")
+		      (ada-goto-matching-start 1 noerror t)
+		    ;; (ada-goto-matching-decl-start noerror t)
+
+                    (setq loop-again nil)
+                    (unless (looking-at "begin")
+                      (setq nest-count (1+ nest-count))))
+                  ))
+              )))
+       ;;
+       ((looking-at "generic")
+        (if count-generic
+            (progn
+              (setq first nil)
+              (setq nest-count (1- nest-count)))))
+       ;;
+       ((looking-at "if")
+	(save-excursion
+	  (forward-word -1)
+	  (unless (looking-at "\\<end[ \t\n]*if\\>")
+	    (progn
+	      (setq nest-count (1- nest-count))
+	      (setq first nil)))))
+
        ;;
        ((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
-        (if (save-excursion
-              (ada-goto-previous-word)
-              (skip-chars-backward "a-zA-Z0-9_.'")
-              (if (save-excursion
-                    (backward-char 1)
-                    (looking-at ")"))
-                  (progn
-                    (forward-char 1)
-                    (backward-sexp 1)
-                    (skip-chars-backward "a-zA-Z0-9_.'")
-                    ))
-              (ada-goto-previous-word)
-              (looking-at "\\<type\\>")) ; end of save-excursion
+        ;; check if it is only a type definition, but not a protected
+        ;; type definition, which should be handled like a procedure.
+        (if (or (looking-at "is[ \t]+<>")
+                (save-excursion
+                  (forward-comment -10000)
+                  (forward-char -1)
+
+                  ;; Detect if we have a closing parenthesis (Could be
+                  ;; either the end of subprogram parameters or (<>)
+                  ;; in a type definition
+                  (if (= (char-after) ?\))
+                      (progn
+                        (forward-char 1)
+                        (backward-sexp 1)
+                        (forward-comment -10000)
+                        ))
+                  (skip-chars-backward "a-zA-Z0-9_.'")
+                  (ada-goto-previous-word)
+                  (and
+                   (looking-at "\\<\\(sub\\)?type\\|case\\>")
+                   (save-match-data
+                     (ada-goto-previous-word)
+                     (not (looking-at "\\<protected\\>"))))
+                  ))                    ; end of `or'
             (goto-char (match-beginning 0))
           (progn
             (setq nest-count (1- nest-count))
@@ -2573,36 +3669,42 @@ This works by two steps:
        ;;
        ((and first
              (looking-at "begin"))
-        (setq nest-count 0)
-        (setq flag t))
+        (setq nest-count 0))
+       ;;
+       ((looking-at "when")
+	(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))
         (setq first nil)))
 
-      )  ;; end of loop
+      );; end of loop
 
     ;; check if declaration-start is really found
-    (if (not
-         (and
-          (zerop nest-count)
-          (not flag)
-          (progn
-            (if (looking-at "is")
-                  (ada-search-ignore-string-comment
-                   "\\<\\(procedure\\|function\\|task\\|package\\)\\>" t)
-              (looking-at "declare\\|generic")))))
-        (if noerror nil
-          (error "no matching procedure/function/task/declare/package"))
-      t)))
-
+    (if (and
+         (zerop nest-count)
+         (if (looking-at "is")
+             (ada-search-ignore-string-comment ada-subprog-start-re t)
+           (looking-at "declare\\|generic")))
+        t
+      (if noerror nil
+        (error "no matching proc/func/task/declare/package/protected")))
+    ))
 
 (defun ada-goto-matching-start (&optional nest-level noerror gotothen)
-  ;; Moves point to the beginning of a block-start.  Which block
-  ;; depends on the value of NEST-LEVEL, which defaults to zero.  If
-  ;; NOERROR is non-nil, it only returns nil if no matching start was
-  ;; found.  If GOTOTHEN is non-nil, point moves to the 'then'
-  ;; following 'if'.
+  "Moves point to the beginning of a block-start.
+Which block depends on the value of NEST-LEVEL, which defaults to zero. If
+NOERROR is non-nil, it only returns nil if no matching start was found.
+If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
   (let ((nest-count (if nest-level nest-level 0))
         (found nil)
         (pos nil))
@@ -2612,393 +3714,350 @@ This works by two steps:
     ;;
     (while (and
             (not found)
-            (ada-search-ignore-string-comment
-             (concat "\\<\\("
-                     "end\\|loop\\|select\\|begin\\|case\\|"
-                     "if\\|task\\|package\\|record\\|do\\)\\>")
-             t))
+            (ada-search-ignore-string-comment ada-matching-start-re t))
 
-      ;;
-      ;; calculate nest-depth
-      ;;
-      (cond
-       ;; found block end => increase nest depth
-       ((looking-at "end")
-        (setq nest-count (1+ nest-count)))
-       ;; found loop/select/record/case/if => check if it starts or
-       ;; ends a block
-       ((looking-at "loop\\|select\\|record\\|case\\|if")
-        (setq pos (point))
-        (save-excursion
+      (unless (and (looking-at "\\<record\\>")
+                   (save-excursion
+                     (forward-word -1)
+                     (looking-at "\\<null\\>")))
+        (progn
           ;;
-          ;; check if keyword follows 'end'
+          ;; calculate nest-depth
           ;;
-          (ada-goto-previous-word)
-          (if (looking-at "\\<end\\>")
-              ;; it ends a block => increase nest depth
-              (progn
-                (setq nest-count (1+ nest-count))
-                (setq pos (point)))
-            ;; it starts a block => decrease nest depth
-            (setq nest-count (1- nest-count))))
-        (goto-char pos))
-       ;; found package start => check if it really is a block
-       ((looking-at "package")
-        (save-excursion
-          (ada-search-ignore-string-comment "\\<is\\>")
-          (ada-goto-next-non-ws)
-          ;; ignore it if it is only a declaration with 'new'
-          (if (not (looking-at "\\<new\\>"))
-              (setq nest-count (1- nest-count)))))
-       ;; found task start => check if it has a body
-       ((looking-at "task")
-        (save-excursion
-          (forward-word 1)
-          (ada-goto-next-non-ws)
-          ;; ignore it if it has no body
-          (if (not (looking-at "\\<body\\>"))
-              (setq nest-count (1- nest-count)))))
-       ;; all the other block starts
-       (t
-        (setq nest-count (1- nest-count)))) ; end of 'cond'
+          (cond
+           ;; found block end => increase nest depth
+           ((looking-at "end")
+            (setq nest-count (1+ nest-count)))
 
-      ;; match is found, if nest-depth is zero
-      ;;
-      (setq found (zerop nest-count))) ; end of loop
+           ;; found loop/select/record/case/if => check if it starts or
+           ;; ends a block
+           ((looking-at "loop\\|select\\|record\\|case\\|if")
+            (setq pos (point))
+            (save-excursion
+              ;;
+              ;; check if keyword follows 'end'
+              ;;
+              (ada-goto-previous-word)
+              (if (looking-at "\\<end\\>[ \t]*[^;]")
+                  ;; it ends a block => increase nest depth
+		  (setq nest-count (1+ nest-count)
+			pos        (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)
-               (back-to-indentation)
-               (looking-at "\\<then\\>")))
-            (goto-char (match-beginning 0)))
-           ;;
-           ;; found 'do' => skip back to 'accept'
-           ;;
-           ((looking-at "do")
-            (if (not (ada-search-ignore-string-comment "\\<accept\\>" t nil))
-                (error "missing 'accept' in front of 'do'"))))
-          (point))
+                ;; it starts a block => decrease nest depth
+                (setq nest-count (1- nest-count))))
+            (goto-char pos))
 
-      (if noerror
-          nil
-        (error "no matching start")))))
+           ;; found package start => check if it really is a block
+           ((looking-at "package")
+            (save-excursion
+              ;; ignore if this is just a renames statement
+              (let ((current (point))
+                    (pos (ada-search-ignore-string-comment
+                          "\\<\\(is\\|renames\\|;\\)\\>" nil)))
+                (if pos
+                    (goto-char (car pos))
+                  (error (concat
+                          "No matching 'is' or 'renames' for 'package' at"
+                          " line "
+                          (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'
+		  ;; 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")
+            (save-excursion
+              (forward-word 1)
+              (ada-goto-next-non-ws)
+              (cond
+               ((looking-at "\\<body\\>"))
+               ((looking-at "\\<type\\>")
+                ;;  In that case, do nothing if there is a "is"
+                (forward-word 2);; skip "type"
+                (ada-goto-next-non-ws);; skip type name
+
+                ;; Do nothing if we are simply looking at a simple
+                ;; "task type name;" statement with no block
+                (unless (looking-at ";")
+                  (progn
+                    ;; Skip the parameters
+                    (if (looking-at "(")
+                        (ada-search-ignore-string-comment ")" nil))
+                    (let ((tmp (ada-search-ignore-string-comment
+                                "\\<\\(is\\|;\\)\\>" nil)))
+                      (if tmp
+                          (progn
+                            (goto-char (car tmp))
+                            (if (looking-at "is")
+                                (setq nest-count (1- nest-count)))))))))
+               (t
+                ;; Check if that task declaration had a block attached to
+                ;; it (i.e do nothing if we have just "task name;")
+                (unless (progn (forward-word 1)
+                               (looking-at "[ \t]*;"))
+                  (setq nest-count (1- nest-count)))))))
+           ;; all the other block starts
+           (t
+            (setq nest-count (1- nest-count)))) ; end of 'cond'
+
+          ;; match is found, if nest-depth is zero
+          ;;
+          (setq found (zerop nest-count))))) ; end of loop
+
+    (if (bobp)
+	(point)
+      (if found
+	  ;;
+	  ;; match found => is there anything else to do ?
+	  ;;
+	  (progn
+	    (cond
+	     ;;
+	     ;; found 'if' => skip to 'then', if it's on a separate line
+	     ;;                               and GOTOTHEN is non-nil
+	     ;;
+	     ((and
+	       gotothen
+	       (looking-at "if")
+	       (save-excursion
+		 (ada-search-ignore-string-comment "then" nil nil nil
+						   'word-search-forward)
+		 (back-to-indentation)
+		 (looking-at "\\<then\\>")))
+	      (goto-char (match-beginning 0)))
+
+	     ;;
+	     ;; found 'do' => skip back to 'accept'
+	     ;;
+	     ((looking-at "do")
+	      (unless (ada-search-ignore-string-comment
+		       "accept" t nil nil
+		       'word-search-backward)
+		(error "missing 'accept' in front of 'do'"))))
+	    (point))
+
+	(if noerror
+	    nil
+	  (error "no matching start"))))))
 
 
 (defun ada-goto-matching-end (&optional nest-level noerror)
-  ;; Moves point to the end of a block.  Which block depends on the
-  ;; value of NEST-LEVEL, which defaults to zero.  If NOERROR is
-  ;; non-nil, it only returns nil if found no matching start.
-  (let ((nest-count (if nest-level nest-level 0))
-        (found nil))
+  "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 (or nest-level 0))
+	(regex (eval-when-compile
+		 (concat "\\<"
+			 (regexp-opt '("end" "loop" "select" "begin" "case"
+				       "if" "task" "package" "record" "do"
+				       "procedure" "function") t)
+			 "\\>")))
+	found
+        pos
+
+	;;  First is used for subprograms: they are generally handled
+	;;  recursively, but of course we do not want to do that the
+	;;  first time (see comment below about subprograms)
+	(first (not (looking-at "declare"))))
+
+    ;;  If we are already looking at one of the keywords, this shouldn't count
+    ;;  in the nesting loop below, so we just make sure we don't count it.
+    ;;  "declare" is a special case because we need to look after the "begin"
+    ;;  keyword
+    (if (looking-at "\\<if\\|loop\\|case\\|begin\\>")
+	(forward-char 1))
 
     ;;
     ;; search forward for interesting keywords
     ;;
     (while (and
             (not found)
-            (ada-search-ignore-string-comment
-             (concat "\\<\\(end\\|loop\\|select\\|begin\\|case\\|"
-                     "if\\|task\\|package\\|record\\|do\\)\\>")))
+            (ada-search-ignore-string-comment regex nil))
 
       ;;
       ;; calculate nest-depth
       ;;
       (backward-word 1)
       (cond
+       ;; procedures and functions need to be processed recursively, in
+       ;; case they are defined in a declare/begin block, as in:
+       ;;    declare  --  NL 0   (nested level)
+       ;;      A : Boolean;
+       ;;      procedure B (C : D) is
+       ;;      begin --  NL 1
+       ;;         null;
+       ;;      end B;   --  NL 0, and we would exit
+       ;;    begin
+       ;;    end; --  we should exit here
+       ;; processing them recursively avoids the need for any special
+       ;; handling.
+       ;; Nothing should be done if we have only the specs or a
+       ;; generic instantion.
+
+       ((and (looking-at "\\<procedure\\|function\\>"))
+	(if first
+	    (forward-word 1)
+
+	  (setq pos (point))
+	  (ada-search-ignore-string-comment "is\\|;")
+	  (if (= (char-before) ?s)
+	      (progn
+		(ada-goto-next-non-ws)
+		(unless (looking-at "\\<new\\>")
+		  (progn
+		    (goto-char pos)
+		    (ada-goto-matching-end 0 t)))))))
+
        ;; found block end => decrease nest depth
        ((looking-at "\\<end\\>")
-        (setq nest-count (1- nest-count))
-        ;; skip the following keyword
-        (if (progn
-              (skip-chars-forward "end")
-              (ada-goto-next-non-ws)
-              (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))
-            (forward-word 1)))
-       ;; found package start => check if it really starts a block
+        (setq nest-count (1- nest-count)
+	      found (<= nest-count 0))
+         ;; skip the following keyword
+	(if (progn
+	      (skip-chars-forward "end")
+	      (ada-goto-next-non-ws)
+	      (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))
+	    (forward-word 1)))
+
+       ;; found package start => check if it really starts a block, and is not
+       ;; in fact a generic instantiation for instance
        ((looking-at "\\<package\\>")
-        (ada-search-ignore-string-comment "\\<is\\>")
+        (ada-search-ignore-string-comment "is" nil nil nil
+                                          'word-search-forward)
         (ada-goto-next-non-ws)
         ;; ignore and skip it if it is only a 'new' package
-        (if (not (looking-at "\\<new\\>"))
-            (setq nest-count (1+ nest-count))
-          (skip-chars-forward "new")))
+        (if (looking-at "\\<new\\>")
+            (goto-char (match-end 0))
+          (setq nest-count (1+ nest-count)
+		found      (<= nest-count 0))))
+
        ;; all the other block starts
        (t
-        (setq nest-count (1+ nest-count))
-        (forward-word 1))) ; end of 'cond'
+	(if (not first)
+	    (setq nest-count (1+ nest-count)))
+	(setq found      (<= nest-count 0))
+        (forward-word 1)))              ; end of 'cond'
 
-      ;; match is found, if nest-depth is zero
-      ;;
-      (setq found (zerop nest-count))) ; end of loop
-
-    (if (not found)
-        (if noerror
-            nil
-          (error "no matching end"))
-      t)))
+      (setq first nil))
 
-
-(defun ada-forward-sexp-ignore-comment ()
-  ;; Skips one sexp forward, ignoring comments.
-  (while (looking-at "[ \t\n]*--")
-    (skip-chars-forward "[ \t\n]")
-    (end-of-line))
-  (forward-sexp 1))
+    (if found
+        t
+      (if noerror
+          nil
+        (error "no matching end")))
+    ))
 
 
 (defun ada-search-ignore-string-comment
-  (search-re &optional backward limit paramlists)
-  ;; Regexp-Search for SEARCH-RE, ignoring comments, strings and
-  ;; parameter lists, if PARAMLISTS is nil. Returns a cons cell of
-  ;; begin and end of match data or nil, if not found.
-  (let ((found nil)
-        (begin nil)
-        (end nil)
-        (pos nil)
-        (search-func
-         (if backward 're-search-backward
-           're-search-forward)))
+  (search-re &optional backward limit paramlists search-func)
+  "Regexp-search for SEARCH-RE, ignoring comments, strings.
+If PARAMLISTS is nil, ignore parameter lists. Returns a cons cell of
+begin and end of match data or nil, if not found.
+The search is done using SEARCH-FUNC, which should search backward if
+BACKWARD is non-nil, forward otherwise. SEARCH-FUNC can be optimized in case
+we are searching for a constant string.
+The search stops at pos LIMIT.
+Point is moved at the beginning of the search-re."
+  (let (found
+        begin
+        end
+        parse-result
+        (previous-syntax-table (syntax-table)))
+
+    (unless search-func
+      (setq search-func (if backward 're-search-backward 're-search-forward)))
 
     ;;
     ;; search until found or end-of-buffer
+    ;; We have to test that we do not look further than limit
     ;;
+    (set-syntax-table ada-mode-symbol-syntax-table)
     (while (and (not found)
+                (or (not limit)
+                    (or (and backward (<= limit (point)))
+                        (>= limit (point))))
                 (funcall search-func search-re limit 1))
       (setq begin (match-beginning 0))
       (setq end (match-end 0))
 
+      (setq parse-result (parse-partial-sexp
+                          (save-excursion (beginning-of-line) (point))
+                          (point)))
+
       (cond
        ;;
-       ;; found in comment => skip it
-       ;;
-       ((ada-in-comment-p)
-        (if backward
-            (progn
-              (re-search-backward "--" nil 1)
-              (goto-char (match-beginning 0)))
-          (progn
-            (forward-line 1)
-            (beginning-of-line))))
-       ;;
-       ;; found in string => skip it
-       ;;
-       ((ada-in-string-p)
-        (if backward
-            (progn
-              (re-search-backward "\"\\|#" nil 1)
-              (goto-char (match-beginning 0))))
-        (re-search-forward "\"\\|#" nil 1))
-       ;;
-       ;; found character constant => ignore it
-       ;;
-       ((save-excursion
-          (setq pos (- (point) (if backward 1 2)))
-          (and (char-after pos)
-               (= (char-after pos) ?')
-               (= (char-after (+ pos 2)) ?')))
-        ())
-       ;;
-       ;; found a parameter-list but should ignore it => skip it
+       ;; If inside a string, skip it (and the following comments)
        ;;
-       ((and (not paramlists)
-             (ada-in-paramlist-p))
-        (if backward
-            (ada-search-ignore-string-comment "(" t nil t)))
+       ((ada-in-string-p parse-result)
+        (if (featurep 'xemacs)
+            (search-backward "\"" nil t)
+          (goto-char (nth 8 parse-result)))
+        (unless backward (forward-sexp 1)))
        ;;
-       ;; directly in front of a comment => skip it, if searching forward
+       ;; If inside a comment, skip it (and the following comments)
+       ;; There is a special code for comments at the end of the file
        ;;
-       ((save-excursion
-          (goto-char begin)
-          (looking-at "--"))
-        (if (not backward)
+       ((ada-in-comment-p parse-result)
+        (if (featurep 'xemacs)
             (progn
               (forward-line 1)
-              (beginning-of-line))))
-       ;;
-       ;; found what we were looking for
-       ;;
-       (t
-        (setq found t)))) ; end of loop
-
-    (if found
-        (cons begin end)
-      nil)))
-
-
-(defun ada-search-but-not (search-re not-search-re &optional backward limit)
-  ;; Searches SEARCH-RE, ignoring parts of NOT-SEARCH-RE, strings,
-  ;; comments and parameter-lists.
-  (let ((begin nil)
-        (end nil)
-        (begin-not nil)
-        (begin-end nil)
-        (end-not nil)
-        (ret-cons nil)
-        (found nil))
-
-    ;;
-    ;; search until found or end-of-buffer
-    ;;
-    (while (and
-            (not found)
-            (save-excursion
-              (setq ret-cons
-                    (ada-search-ignore-string-comment search-re
-                                                      backward limit))
-              (if (consp ret-cons)
-                  (progn
-                    (setq begin (car ret-cons))
-                    (setq end (cdr ret-cons))
-                    t)
-                nil)))
-
-      (if (or
-           ;;
-           ;; if no NO-SEARCH-RE was found
-           ;;
-           (not
-            (save-excursion
-              (setq ret-cons
-                    (ada-search-ignore-string-comment not-search-re
-                                                      backward nil))
-              (if (consp ret-cons)
-                  (progn
-                    (setq begin-not (car ret-cons))
-                    (setq end-not (cdr ret-cons))
-                    t)
-                nil)))
-           ;;
-           ;;  or this NO-SEARCH-RE is not a part of the SEARCH-RE
-           ;;  found before.
-           ;;
-           (or
-            (<= end-not begin)
-            (>= begin-not end)))
-
-          (setq found t)
-
-        ;;
-        ;; not found the correct match => skip this match
-        ;;
-        (goto-char (if backward
-                       begin
-                     end)))) ; end of loop
-
-    (if found
-        (progn
-          (goto-char begin)
-          (cons begin end))
-      nil)))
-
-
-(defun ada-goto-prev-nonblank-line ( &optional ignore-comment)
-  ;; Moves point to previous non-blank line,
-  ;; ignoring comments if IGNORE-COMMENT is non-nil.
-  ;; It returns t if a matching line was found.
-  (let ((notfound t)
-        (newpoint nil))
-
-    (save-excursion
-      ;;
-      ;; backward one line, if there is one
-      ;;
-      (if (zerop (forward-line -1))
-          ;;
-          ;; there is some kind of previous line
-          ;;
-          (progn
-            (beginning-of-line)
-            (setq newpoint (point))
-
-            ;;
-            ;; search until found or beginning-of-buffer
-            ;;
-            (while (and (setq notfound
-                              (or (looking-at "[ \t]*$")
-                                  (and (looking-at "[ \t]*--")
-                                       ignore-comment)))
-                        (not (in-limit-line-p)))
-              (forward-line -1)
-              (beginning-of-line)
-              (setq newpoint (point))) ; end of loop
-
-            )) ; end of if
-
-      ) ; end of save-excursion
-
-    (if notfound nil
-      (progn
-        (goto-char newpoint)
-        t))))
-
-
-(defun ada-goto-next-nonblank-line ( &optional ignore-comment)
-  ;; Moves point to next non-blank line,
-  ;; ignoring comments if IGNORE-COMMENT is non-nil.
-  ;; It returns t if a matching line was found.
-  (let ((notfound t)
-        (newpoint nil))
-
-    (save-excursion
-    ;;
-    ;; forward one line
-    ;;
-      (if (zerop (forward-line 1))
-          ;;
-          ;; there is some kind of previous line
-          ;;
-          (progn
-            (beginning-of-line)
-            (setq newpoint (point))
-
-            ;;
-            ;; search until found or end-of-buffer
-            ;;
-            (while (and (setq notfound
-                              (or (looking-at "[ \t]*$")
-                                  (and (looking-at "[ \t]*--")
-                                       ignore-comment)))
-                        (not (in-limit-line-p)))
-              (forward-line 1)
               (beginning-of-line)
-              (setq newpoint (point))) ; end of loop
-
-            )) ; end of if
+              (forward-comment -1))
+          (goto-char (nth 8 parse-result)))
+        (unless backward
+          ;;  at the end of the file, it is not possible to skip a comment
+          ;;  so we just go at the end of the line
+          (if (forward-comment 1)
+              (progn
+                (forward-comment 1000)
+                (beginning-of-line))
+            (end-of-line))))
+       ;;
+       ;; directly in front of a comment => skip it, if searching forward
+       ;;
+       ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-))
+        (unless backward (progn (forward-char -1) (forward-comment 1000))))
 
-      ) ; end of save-excursion
+       ;;
+       ;; found a parameter-list but should ignore it => skip it
+       ;;
+       ((and (not paramlists) (ada-in-paramlist-p))
+        (if backward
+            (search-backward "(" nil t)
+          (search-forward ")" nil t)))
+       ;;
+       ;; found what we were looking for
+       ;;
+       (t
+        (setq found t))))               ; end of loop
 
-    (if notfound nil
-      (progn
-        (goto-char newpoint)
-        t))))
+    (set-syntax-table previous-syntax-table)
 
+    (if found
+        (cons begin end)
+      nil)))
 
-;; ---- boolean functions for indentation
+;; -------------------------------------------------------
+;; --  Testing the position of the cursor
+;; -------------------------------------------------------
 
 (defun ada-in-decl-p ()
-  ;; Returns t if point is inside a declarative part.
-  ;; Assumes point to be at the end of a statement.
-  (or
-   (ada-in-paramlist-p)
-   (save-excursion
-     (ada-goto-matching-decl-start t))))
+  "Returns t if point is inside a declarative part.
+Assumes point to be at the end of a statement."
+  (or (ada-in-paramlist-p)
+      (save-excursion
+        (ada-goto-matching-decl-start t))))
 
 
 (defun ada-looking-at-semi-or ()
-  ;; Returns t if looking-at an 'or' following a semicolon.
+  "Returns t if looking-at an 'or' following a semicolon."
   (save-excursion
     (and (looking-at "\\<or\\>")
          (progn
@@ -3008,280 +4067,142 @@ This works by two steps:
 
 
 (defun ada-looking-at-semi-private ()
-  ;; Returns t if looking-at an 'private' following a semicolon.
+  "Returns t if looking at the start of a private section in a package.
+Returns nil if the private is part of the package name, as in
+'private package A is...' (this can only happen at top level)."
   (save-excursion
     (and (looking-at "\\<private\\>")
-         (progn
-           (forward-word 1)
-           (ada-goto-stmt-start)
-           (looking-at "\\<private\\>")))))
-
-
-(defun in-limit-line-p ()
-  ;; Returns t if point is in first or last accessible line.
-  (or
-   (>= 1 (count-lines (point-min) (point)))
-   (>= 1 (count-lines (point) (point-max)))))
-
-
-(defun ada-in-comment-p ()
-  ;; Returns t if inside a comment.
-  (save-excursion (and (re-search-backward "\\(--\\|\n\\)" nil 1)
-                       (looking-at "-"))))
-
-
-(defun ada-in-string-p ()
-  ;; Returns t if point is inside a string
-  ;; (Taken from pascal-mode.el, modified by MH).
-  (save-excursion
-    (and
-     (nth 3 (parse-partial-sexp
-             (save-excursion
-               (beginning-of-line)
-               (point)) (point)))
-     ;; check if 'string quote' is only a character constant
-     (progn
-       (re-search-backward "\"\\|#" nil t)
-       (not (= (char-after (1- (point))) ?'))))))
-
-
-(defun ada-in-string-or-comment-p ()
-  ;; Returns t if point is inside a string or a comment.
-  (or (ada-in-comment-p)
-      (ada-in-string-p)))
+         (not (looking-at "\\<private[ \t]*\\(package\\|generic\\)"))
+
+	 ;;  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)
+		(and (not (bobp))
+		     (or (= (char-before) ?\;)
+			 (and (forward-word -3)
+			      (looking-at "\\<package\\>"))))))))
 
 
 (defun ada-in-paramlist-p ()
-  ;; Returns t if point is inside a parameter-list
-  ;; following 'function'/'procedure'/'package'.
+  "Returns t if point is inside a parameter-list."
   (save-excursion
     (and
-     (re-search-backward "(\\|)" nil t)
+     (ada-search-ignore-string-comment "(\\|)" t nil t)
      ;; inside parentheses ?
-     (looking-at "(")
-     (backward-word 2)
-     ;; right keyword before paranthesis ?
-     (looking-at (concat "\\<\\("
-                         "procedure\\|function\\|body\\|package\\|"
-                         "task\\|entry\\|accept\\)\\>"))
-     (re-search-forward ")\\|:" nil t)
-     ;; at least one ':' inside the parentheses ?
-     (not (backward-char 1))
-     (looking-at ":"))))
-
-
-;; not really a boolean function ...
-(defun ada-in-open-paren-p ()
-  ;; If point is somewhere behind an open parenthesis not yet closed,
-  ;; it returns the column # of the first non-ws behind this open
-  ;; parenthesis, otherwise nil."
-  (let ((nest-count 1)
-        (limit nil)
-        (found nil)
-        (pos nil)
-        (col nil)
-        (counter ada-search-paren-line-count-limit))
-
-    ;;
-    ;; get search-limit
-    ;;
-    (if ada-search-paren-line-count-limit
-        (setq limit
-              (save-excursion
-                (while (not (zerop counter))
-                  (ada-goto-prev-nonblank-line)
-                  (setq counter (1- counter)))
-                (beginning-of-line)
-                (point))))
-
-    (save-excursion
+     (= (char-after) ?\()
 
-      ;;
-      ;; loop until found or limit
-      ;;
-      (while (and
-              (not found)
-              (ada-search-ignore-string-comment "(\\|)" t limit t))
-        (setq nest-count
-              (if (looking-at ")")
-                  (1+ nest-count)
-                (1- nest-count)))
-        (setq found (zerop nest-count))) ; end of loop
+     ;; We could be looking at two things here:
+     ;;  operator definition:   function "." (
+     ;;  subprogram definition: procedure .... (
+     ;; Let's skip back over the first one
+     (progn
+       (skip-chars-backward " \t\n")
+       (if (= (char-before) ?\")
+           (backward-char 3)
+         (backward-word 1))
+       t)
+
+     ;; and now over the second one
+     (backward-word 1)
+
+     ;; We should ignore the case when the reserved keyword is in a
+     ;; comment (for instance, when we have:
+     ;;    -- .... package
+     ;;    Test (A)
+     ;; we should return nil
+
+     (not (ada-in-string-or-comment-p))
+
+     ;; right keyword two words before parenthesis ?
+     ;; Type is in this list because of discriminants
+     (looking-at (eval-when-compile
+                   (concat "\\<\\("
+                           "procedure\\|function\\|body\\|"
+                           "task\\|entry\\|accept\\|"
+                           "access[ \t]+procedure\\|"
+                           "access[ \t]+function\\|"
+                           "pragma\\|"
+                           "type\\)\\>"))))))
+
+(defun ada-search-ignore-complex-boolean (regexp backwardp)
+  "Like `ada-search-ignore-string-comment', except that it also ignores
+boolean expressions 'and then' and 'or else'."
+  (let (result)
+  (while (and (setq result (ada-search-ignore-string-comment regexp backwardp))
+	      (save-excursion (forward-word -1)
+			      (looking-at "and then\\|or else"))))
+  result))
 
-      (if found
-          ;; if found => return column of first non-ws after the parenthesis
+(defun ada-in-open-paren-p ()
+  "Returns the position of the first non-ws behind the last unclosed
+parenthesis, or nil."
+  (save-excursion
+    (let ((parse (parse-partial-sexp
+                  (point)
+                  (or (car (ada-search-ignore-complex-boolean
+                            "\\<\\(;\\|is\\|then\\|loop\\|begin\\|else\\)\\>"
+                            t))
+                      (point-min)))))
+
+      (if (nth 1 parse)
           (progn
-            (forward-char 1)
-            (if (save-excursion
-                  (re-search-forward "[^ \t]" nil 1)
-                  (backward-char 1)
-                  (and
-                   (not (looking-at "\n"))
-                   (setq col (current-column))))
-                col
-              (current-column)))
-        nil))))
-
-
-;;;-----------------------------;;;
-;;; Simple Completion Functions ;;;
-;;;-----------------------------;;;
-
-;; These are my first steps in Emacs-Lisp ... :-) They can be replaced
-;; by functions based on the output of the Gnatf Tool that comes with
-;; the GNAT Ada compiler. See the file ada-xref.el (MH) But you might
-;; use these functions if you don't use GNAT
-
-(defun ada-use-last-with ()
-  "Inserts the package name of the last 'with' statement after use."
-  (interactive)
-  (let ((pakname nil))
-    (save-excursion
-      (forward-word -1)
-      (if (looking-at "use")
-          ;;
-          ;; find last 'with'
-          ;;
-          (progn (re-search-backward
-                  "\\(\\<with\\s-+\\)\\([a-zA-Z0-9_.]+\\)\\(\\s-*;\\)")
-                 ;;
-                 ;; get the name of the package
-                 ;;
-                 (setq pakname (concat
-                                (buffer-substring (match-beginning 2)
-                                                  (match-end 2))
-                                ";")))
-        (setq pakname "")))
-    (insert pakname)))
-
-
-(defun ada-complete-symbol (symboldef position symalist)
-  ;; Tries to complete a symbol in the buffer.
-  ;; SYMBOLDEF is the regexp to find the definition of the desired symbol.
-  ;; POSITION is the position of the subexpression in SYMBOLDEF to match
-  ;; the symbol itself.
-  ;; SYMALIST is an alist with possibly predefined completions."
-  (let ((sofar nil)
-        (completed nil)
-        (insertpos nil))
-    (save-excursion
-      ;;
-      ;; get the part of the symbol already typed
-      ;;
-      (re-search-backward "\\([^a-zA-Z0-9_\\.]\\)\\([a-zA-Z0-9_\\.]+\\)")
-      (setq sofar (buffer-substring (match-beginning 2)
-                                    (match-end 2)))
-      ;;
-      ;; delete it
-      ;;
-      (delete-region (setq insertpos (match-beginning 2))
-                     (match-end 2))
-      ;;
-      ;; find all possible completions by searching for definitions of
-      ;; this kind of symbol
-      ;;
-      (while (re-search-backward symboldef nil t)
-        ;;
-        ;; build an alist of these possible completions
-        ;;
-        (setq symalist (cons (cons (buffer-substring (match-beginning position)
-                                                     (match-end position))
-                                   nil)
-                             symalist)))
-
-      (or
-       ;;
-       ;; symbol gets completed as far as possible
-       ;;
-       (stringp (setq completed (try-completion sofar symalist)))
-       ;;
-       ;; or is already complete
-       ;;
-       (setq completed sofar)))
-    ;;
-    ;; insert the completed symbol
-    ;;
-    (goto-char insertpos)
-    (insert completed)))
+            (goto-char (1+ (nth 1 parse)))
 
+	    ;;  Skip blanks, if they are not followed by a comment
+	    ;;  See:
+	    ;;  type A is (   Value_0,
+	    ;;                Value_1);
+	    ;;  type B is (   --  comment
+	    ;;             Value_2);
 
-(defun ada-complete-use ()
-  "Tries to complete the package name in an 'use' statement in the buffer.
-Searches through former 'with' statements for possible completions."
-  (interactive)
-  (ada-complete-symbol
-   "\\(\\<with\\s-+\\)\\([a-zA-Z0-9_.]+\\)\\(\\s-*;\\)" 2 nil)
-  (insert ";"))
-
-
-(defun ada-complete-procedure ()
-  "Tries to complete a procedure/function name in the buffer."
-  (interactive)
-  (ada-complete-symbol ada-procedure-start-regexp 2 nil))
-
-
-(defun ada-complete-variable ()
-  "Tries to complete a variable name in the buffer."
-  (interactive)
-  (ada-complete-symbol
-   "\\([^a-zA-Z0-9_]\\)\\([a-zA-Z0-9_]+\\)[ \t\n]+\\(:\\)" 2 nil))
-
+	    (if (or (not ada-indent-handle-comment-special)
+		    (not (looking-at "[ \t]+--")))
+	        (skip-chars-forward " \t"))
 
-(defun ada-complete-type ()
-  "Tries to complete a type name in the buffer."
-  (interactive)
-  (ada-complete-symbol "\\(type\\)[ \t\n]+\\([a-zA-Z0-9_\\.]+\\)"
-                       2
-                       '(("Integer" nil)
-                         ("Long_Integer" nil)
-                         ("Natural" nil)
-                         ("Positive" nil)
-                         ("Short_Integer" nil))))
+            (point))))))
 
 
-;;;----------------------;;;
-;;; Behaviour Of TAB Key ;;;
-;;;----------------------;;;
+;; -----------------------------------------------------------
+;; --  Behavior Of TAB Key
+;; -----------------------------------------------------------
 
 (defun ada-tab ()
-  "Do indenting or tabbing according to `ada-tab-policy'."
+  "Do indenting or tabbing according to `ada-tab-policy'.
+In Transient Mark mode, if the mark is active, operate on the contents
+of the region.  Otherwise, operates only on the current line."
   (interactive)
-  (cond ((eq ada-tab-policy 'indent-and-tab) (error "not implemented"))
-        ;; ada-indent-and-tab
-        ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
-        ((eq ada-tab-policy 'indent-auto) (ada-indent-current))
-        ((eq ada-tab-policy 'gei) (ada-tab-gei))
-        ((eq ada-tab-policy 'indent-af) (af-indent-line)) ; GEB
+  (cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
+        ((eq ada-tab-policy 'indent-auto)
+	 (if (ada-region-selected)
+             (ada-indent-region (region-beginning) (region-end))
+           (ada-indent-current)))
         ((eq ada-tab-policy 'always-tab) (error "not implemented"))
         ))
 
-
 (defun ada-untab (arg)
   "Delete leading indenting according to `ada-tab-policy'."
   (interactive "P")
   (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard))
-        ((eq ada-tab-policy 'indent-af) (backward-delete-char-untabify ; GEB
-                                         (prefix-numeric-value arg) ; GEB
-                                         arg)) ; GEB
         ((eq ada-tab-policy 'indent-auto) (error "not implemented"))
         ((eq ada-tab-policy 'always-tab) (error "not implemented"))
         ))
 
-
 (defun ada-indent-current-function ()
-  "ada-mode version of the indent-line-function."
+  "Ada mode version of the indent-line-function."
   (interactive "*")
   (let ((starting-point (point-marker)))
-    (ada-beginning-of-line)
+    (beginning-of-line)
     (ada-tab)
     (if (< (point) starting-point)
         (goto-char starting-point))
     (set-marker starting-point nil)
     ))
 
-
-
-
 (defun ada-tab-hard ()
   "Indent current line to next tab stop."
   (interactive)
@@ -3291,65 +4212,234 @@ Searches through former 'with' statements for possible completions."
   (if (save-excursion (= (point) (progn (beginning-of-line) (point))))
       (forward-char ada-indent)))
 
-
 (defun ada-untab-hard ()
   "indent current line to previous tab stop."
   (interactive)
   (let  ((bol (save-excursion (progn (beginning-of-line) (point))))
-        (eol (save-excursion (progn (end-of-line) (point)))))
+         (eol (save-excursion (progn (end-of-line) (point)))))
     (indent-rigidly bol eol  (- 0 ada-indent))))
 
 
-(defun ada-tabsize (s)
-  "changes spacing used for indentation. Reads spacing from minibuffer."
-  (interactive "nnew indentation spacing: ")
-  (setq ada-indent s))
-
 
-;;;---------------;;;
-;;; Miscellaneous ;;;
-;;;---------------;;;
+;; ------------------------------------------------------------
+;; --  Miscellaneous
+;; ------------------------------------------------------------
 
+;;  Not needed any more for Emacs 21.2, but still needed for backward
+;;  compatibility
 (defun ada-remove-trailing-spaces  ()
-;; remove all trailing spaces at the end of lines.
- "remove trailing spaces in the whole buffer."
+  "Remove trailing spaces in the whole buffer."
+  (interactive)
+  (save-match-data
+    (save-excursion
+      (save-restriction
+        (widen)
+        (goto-char (point-min))
+        (while (re-search-forward "[ \t]+$" (point-max) t)
+          (replace-match "" nil nil))))))
+
+(defun ada-gnat-style ()
+  "Clean up comments, `(' and `,' for GNAT style checking switch."
   (interactive)
   (save-excursion
+
+    ;;  The \n is required, or the line after an empty comment line is
+    ;;  simply ignored.
+    (goto-char (point-min))
+    (while (re-search-forward "--[ \t]*\\([^-\n]\\)" nil t)
+      (replace-match "--  \\1")
+      (forward-line 1)
+      (beginning-of-line))
+
+    (goto-char (point-min))
+    (while (re-search-forward "\\>(" nil t)
+      (if (not (ada-in-string-or-comment-p))
+	  (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)
+      (if (not (ada-in-string-or-comment-p))
+	  (replace-match "(")))
     (goto-char (point-min))
-    (while (re-search-forward "[ \t]+$" nil t)
-      (replace-match "" nil nil))))
+    (while (re-search-forward ")[ \t]+)" nil t)
+      (if (not (ada-in-string-or-comment-p))
+	  (replace-match "))")))
+    (goto-char (point-min))
+    (while (re-search-forward "\\>:" nil t)
+      (if (not (ada-in-string-or-comment-p))
+	  (replace-match " :")))
 
+    ;;  Make sure there is a space after a ','.
+    ;;  Always go back to the beginning of the match, since otherwise
+    ;;  a statement like  ('F','D','E') is incorrectly modified.
+    (goto-char (point-min))
+    (while (re-search-forward ",[ \t]*\\(.\\)" nil t)
+      (if (not (save-excursion
+		 (goto-char (match-beginning 0))
+		 (ada-in-string-or-comment-p)))
+	  (replace-match ", \\1")))
 
-(defun ada-untabify-buffer ()
-;; change all tabs to spaces
-  (save-excursion
-    (untabify (point-min) (point-max))))
+    ;;  Operators should be surrounded by spaces.
+    (goto-char (point-min))
+    (while (re-search-forward
+	    "[ \t]*\\(/=\\|\\*\\*\\|:=\\|\\.\\.\\|[-:+*/]\\)[ \t]*"
+	    nil t)
+      (goto-char (match-beginning 1))
+      (if (or (looking-at "--")
+	      (ada-in-string-or-comment-p))
+	  (progn
+	    (forward-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)))
+    ))
 
 
-(defun ada-uncomment-region (beg end)
-  "delete comment-start at the beginning of a line in the region."
-  (interactive "r")
-  (comment-region beg end -1))
+
+;; -------------------------------------------------------------
+;; --  Moving To Procedures/Packages/Statements
+;; -------------------------------------------------------------
 
+(defun ada-move-to-start ()
+  "Moves point to the matching start of the current Ada structure."
+  (interactive)
+  (let ((pos (point))
+        (previous-syntax-table (syntax-table)))
+    (unwind-protect
+        (progn
+          (set-syntax-table ada-mode-symbol-syntax-table)
 
-;; define a function to support find-file.el if loaded
-(defun ada-ff-other-window ()
-  "Find other file in other window using ff-find-other-file."
+          (save-excursion
+            ;;
+            ;; do nothing if in string or comment or not on 'end ...;'
+            ;;            or if an error occurs during processing
+            ;;
+            (or
+             (ada-in-string-or-comment-p)
+             (and (progn
+                    (or (looking-at "[ \t]*\\<end\\>")
+                        (backward-word 1))
+                    (or (looking-at "[ \t]*\\<end\\>")
+                        (backward-word 1))
+                    (or (looking-at "[ \t]*\\<end\\>")
+                        (error "not on end ...;")))
+                  (ada-goto-matching-start 1)
+                  (setq pos (point))
+
+                  ;;
+                  ;; on 'begin' => go on, according to user option
+                  ;;
+                  ada-move-to-declaration
+                  (looking-at "\\<begin\\>")
+                  (ada-goto-matching-decl-start)
+                  (setq pos (point))))
+
+            )                           ; end of save-excursion
+
+          ;; now really move to the found position
+          (goto-char pos))
+
+      ;; restore syntax-table
+      (set-syntax-table previous-syntax-table))))
+
+(defun ada-move-to-end ()
+  "Moves point to the matching end of the block around point.
+Moves to 'begin' if in a declarative part."
   (interactive)
-  (and (fboundp 'ff-find-other-file)
-       (ff-find-other-file t)))
+  (let ((pos (point))
+	decl-start
+        (previous-syntax-table (syntax-table)))
+    (unwind-protect
+        (progn
+          (set-syntax-table ada-mode-symbol-syntax-table)
 
-
-;;;-------------------------------;;;
-;;; Moving To Procedures/Packages ;;;
-;;;-------------------------------;;;
+          (save-excursion
+
+            (cond
+             ;; Go to the beginning of the current word, and check if we are
+             ;; directly on 'begin'
+	     ((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)
+                     (looking-at "\\<task\\>" )
+                     (forward-word 1)
+                     (ada-goto-next-non-ws)
+                     (looking-at "\\<body\\>")))
+              (ada-search-ignore-string-comment "begin" nil nil nil
+                                                'word-search-forward))
+             ;; accept block start
+             ((save-excursion
+                (and (ada-goto-stmt-start)
+                     (looking-at "\\<accept\\>" )))
+              (ada-goto-matching-end 0))
+             ;; package start
+             ((save-excursion
+		(setq decl-start (and (ada-goto-matching-decl-start t) (point)))
+                (and decl-start (looking-at "\\<package\\>")))
+              (ada-goto-matching-end 1))
+
+	     ;;  On a "declare" keyword
+	     ((save-excursion
+		(skip-syntax-backward "w")
+		(looking-at "\\<declare\\>"))
+	      (ada-goto-matching-end 0 t))
+
+             ;; inside a 'begin' ... 'end' block
+             (decl-start
+	      (goto-char decl-start)
+	      (ada-goto-matching-end 0 t))
+
+             ;; (hopefully ;-) everything else
+             (t
+              (ada-goto-matching-end 1)))
+            (setq pos (point))
+            )
+
+          ;; now really move to the position found
+          (goto-char pos))
+
+      ;; restore syntax-table
+      (set-syntax-table previous-syntax-table))))
 
 (defun ada-next-procedure ()
   "Moves point to next procedure."
   (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 ()
@@ -3357,7 +4447,7 @@ Searches through former 'with' statements for possible completions."
   (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 ()
@@ -3377,403 +4467,1026 @@ Searches through former 'with' statements for possible completions."
     (error "No more packages")))
 
 
-;;;-----------------------
-;;; define keymap for Ada
-;;;-----------------------
+;; ------------------------------------------------------------
+;; --  Define keymap and menus for Ada
+;; -------------------------------------------------------------
+
+(defun ada-create-keymap ()
+  "Create the keymap associated with the Ada mode."
+
+  ;; Indentation and Formatting
+  (define-key ada-mode-map "\C-j"     'ada-indent-newline-indent-conditional)
+  (define-key ada-mode-map "\C-m"     'ada-indent-newline-indent-conditional)
+  (define-key ada-mode-map "\t"       'ada-tab)
+  (define-key ada-mode-map "\C-c\t"   'ada-justified-indent-current)
+  (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region)
+  (if (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.
+
+  ;; Movement
+  (define-key ada-mode-map "\M-\C-e"  'ada-next-procedure)
+  (define-key ada-mode-map "\M-\C-a"  'ada-previous-procedure)
+  (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start)
+  (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end)
+
+  ;; Compilation
+  (unless (lookup-key ada-mode-map "\C-c\C-c")
+    (define-key ada-mode-map "\C-c\C-c" 'compile))
+
+  ;; Casing
+  (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
+  ;; account
+  (if (boundp 'delete-key-deletes-forward)
+      (define-key ada-mode-map [backspace] 'backward-delete-char-untabify)
+    (define-key ada-mode-map "\177" 'backward-delete-char-untabify))
+
+  ;; Make body
+  (define-key ada-mode-map "\C-c\C-n" 'ada-make-subprogram-body)
+
+  ;; 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))
+  )
 
-(if (not ada-mode-map)
-    (progn
-      (setq ada-mode-map (make-sparse-keymap))
-
-      ;; Indentation and Formatting
-      (define-key ada-mode-map "\C-j"     'ada-indent-newline-indent)
-      (define-key ada-mode-map "\t"       'ada-tab)
-      (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region)
-      ;; How do I write this for working with Lucid Emacs?
-      (define-key ada-mode-map [S-tab]    'ada-untab)
-      (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist)
-      (define-key ada-mode-map "\C-c\C-p" 'ada-call-pretty-printer)
-;;; We don't want to make meta-characters case-specific.
-;;;   (define-key ada-mode-map "\M-Q"     'ada-fill-comment-paragraph-justify)
-      (define-key ada-mode-map "\M-\C-q"  'ada-fill-comment-paragraph-postfix)
-
-      ;; Movement
-;;; It isn't good to redefine these.  What should be done instead?  -- rms.
-;;;   (define-key ada-mode-map "\M-e"     'ada-next-procedure)
-;;;   (define-key ada-mode-map "\M-a"     'ada-previous-procedure)
-      (define-key ada-mode-map "\M-\C-e"  'ada-next-package)
-      (define-key ada-mode-map "\M-\C-a"  'ada-previous-package)
-      (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start)
-      (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end)
-
-      ;; Compilation
-      (define-key ada-mode-map "\C-c\C-c" 'compile)
-
-      ;; Casing
-      (define-key ada-mode-map "\C-c\C-r" 'ada-adjust-case-region)
-      (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer)
-
-      (define-key ada-mode-map "\177"     'backward-delete-char-untabify)
-
-      ;; 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)
-
-      ;; Change basic functionality
-      (mapcar (lambda (pair)
-                (substitute-key-definition (car pair) (cdr pair)
-                                           ada-mode-map global-map))
-              '((beginning-of-line      . ada-beginning-of-line)
-                (end-of-line            . ada-end-of-line)
-                (forward-to-indentation . ada-forward-to-indentation)
-                ))
-      ))
 
-
-;;;-------------------
-;;; define menu 'Ada'
-;;;-------------------
-
-(defun ada-add-ada-menu ()
-  "Adds the menu 'Ada' to the menu-bar in Ada Mode."
-  (easy-menu-define t ada-mode-map t
-                    '("Ada"
-                      ["next package" ada-next-package t]
-                      ["previous package" ada-previous-package t]
-                      ["next procedure" ada-next-procedure t]
-                      ["previous procedure" ada-previous-procedure t]
-                      ["goto start" ada-move-to-start t]
-                      ["goto end" ada-move-to-end t]
-                      ["------------------" nil nil]
-                      ["indent current line (TAB)"
-                       ada-indent-current-function t]
-                      ["indent lines in region" ada-indent-region t]
-                      ["format parameter list" ada-format-paramlist t]
-                      ["pretty print buffer" ada-call-pretty-printer t]
-                      ["------------" nil nil]
-                      ["fill comment paragraph"
-                       ada-fill-comment-paragraph t]
-                      ["justify comment paragraph"
-                       ada-fill-comment-paragraph-justify t]
-                      ["postfix comment paragraph"
-                       ada-fill-comment-paragraph-postfix t]
-                      ["------------" nil nil]
-                      ["adjust case region" ada-adjust-case-region t]
-                      ["adjust case buffer" ada-adjust-case-buffer t]
-                      ["----------" nil nil]
-                      ["comment   region" comment-region t]
-                      ["uncomment region" ada-uncomment-region t]
-                      ["----------------" nil nil]
-                      ["compile" compile (fboundp 'compile)]
-                      ["next error" next-error (fboundp 'next-error)]
-                      ["---------------" nil nil]
-                      ["Index" imenu (fboundp 'imenu)]
-                      ["--------------" nil nil]
-                      ["other file other window" ada-ff-other-window
-                       (fboundp 'ff-find-other-file)]
-                      ["other file" ff-find-other-file
-                       (fboundp 'ff-find-other-file)])))
+(defun ada-create-menu ()
+  "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)
+    (if (featurep 'xemacs)
+	(progn
+	  (define-key ada-mode-map [menu-bar] ada-mode-menu)
+	  (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
 
 
-;;;-------------------------------
-;;; Define Some Support Functions
-;;;-------------------------------
+;; -------------------------------------------------------
+;;     Commenting/Uncommenting code
+;;  The following two calls are provided to enhance the standard
+;;  comment-region function, which only allows uncommenting if the
+;;  comment is at the beginning of a line. If the line have been re-indented,
+;;  we are unable to use comment-region, which makes no sense.
+;;
+;;  In addition, we provide an interface to the standard comment handling
+;;  function for justifying the comments.
+;; -------------------------------------------------------
+
+(defadvice comment-region (before ada-uncomment-anywhere disable)
+  (if (and arg
+           (listp arg)  ;;  a prefix with \C-u is of the form '(4), whereas
+	               ;;  \C-u 2  sets arg to '2'  (fixed by S.Leake)
+           (string= mode-name "Ada"))
+      (save-excursion
+        (let ((cs (concat "^[ \t]*" (regexp-quote comment-start))))
+          (goto-char beg)
+          (while (re-search-forward cs end t)
+            (replace-match comment-start))
+          ))))
+
+(defun ada-uncomment-region (beg end &optional arg)
+  "Delete `comment-start' at the beginning of a line in the region."
+  (interactive "r\nP")
+
+  ;;  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) (featurep 'xemacs))
+      (progn
+	(ad-activate 'comment-region)
+	(comment-region beg end (- (or arg 2)))
+	(ad-deactivate 'comment-region))
+    (comment-region beg end (list (- (or arg 2))))
+    (ada-indent-region beg end)))
 
-(defun ada-beginning-of-line (&optional arg)
-  (interactive "P")
-  (cond
-   ((eq ada-tab-policy 'indent-af) (af-beginning-of-line arg))
-   (t (beginning-of-line arg))
-   ))
+(defun ada-fill-comment-paragraph-justify ()
+  "Fills current comment paragraph and justifies each line as well."
+  (interactive)
+  (ada-fill-comment-paragraph 'full))
+
+(defun ada-fill-comment-paragraph-postfix ()
+  "Fills current comment paragraph and justifies each line as well.
+Adds `ada-fill-comment-postfix' at the end of each line."
+  (interactive)
+  (ada-fill-comment-paragraph 'full t))
 
-(defun ada-end-of-line (&optional arg)
+(defun ada-fill-comment-paragraph (&optional justify postfix)
+  "Fills the current comment paragraph.
+If JUSTIFY is non-nil, each line is justified as well.
+If POSTFIX and JUSTIFY are  non-nil, `ada-fill-comment-postfix' is appended
+to each filled and justified line.
+The paragraph is indented on the first line."
   (interactive "P")
-  (cond
-   ((eq ada-tab-policy 'indent-af) (af-end-of-line arg))
-   (t (end-of-line arg))
-   ))
 
-(defun ada-current-column ()
-  (cond
-   ((eq ada-tab-policy 'indent-af) (af-current-column))
-   (t (current-column))
-   ))
+  ;; check if inside comment or just in front a comment
+  (if (and (not (ada-in-comment-p))
+           (not (looking-at "[ \t]*--")))
+      (error "not inside comment"))
 
-(defun ada-forward-to-indentation (&optional arg)
-  (interactive "P")
-  (cond
-   ((eq ada-tab-policy 'indent-af) (af-forward-to-indentation arg))
-   (t (forward-to-indentation arg))
-   ))
+  (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
+         (parse-sexp-lookup-properties nil)
 
-;;;---------------------------------------------------
-;;; support for find-file
-;;;---------------------------------------------------
+         fill-prefix
+         (fill-column (current-fill-column)))
 
-(defvar ada-krunch-args "8"
-  "*Argument of gnatk8, a string containing the max number of characters.
-Set to a big number, if you dont use crunched filenames.")
+    ;;  Find end of paragraph
+    (back-to-indentation)
+    (while (and (not (eobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
+      (forward-line 1)
+
+      ;;  If we were at the last line in the buffer, create a dummy empty
+      ;;  line at the end of the buffer.
+      (if (eobp)
+	  (insert "\n")
+	(back-to-indentation)))
+    (beginning-of-line)
+    (setq to (point-marker))
+    (goto-char opos)
+
+    ;;  Find beginning of paragraph
+    (back-to-indentation)
+    (while (and (not (bobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
+      (forward-line -1)
+      (back-to-indentation))
+
+    ;;  We want one line above the first one, unless we are at the beginning
+    ;;  of the buffer
+    (unless (bobp)
+      (forward-line 1))
+    (beginning-of-line)
+    (setq from (point-marker))
+
+    ;;  Calculate the indentation we will need for the paragraph
+    (back-to-indentation)
+    (setq indent (current-column))
+    ;;  unindent the first line of the paragraph
+    (delete-region from (point))
+
+    ;;  Remove the old postfixes
+    (goto-char from)
+    (while (re-search-forward "--\n" to t)
+      (replace-match "\n"))
+
+    (goto-char (1- to))
+    (setq to (point-marker))
+
+    ;;  Indent and justify the paragraph
+    (setq fill-prefix ada-fill-comment-prefix)
+    (set-left-margin from to indent)
+    (if postfix
+        (setq fill-column (- fill-column (length ada-fill-comment-postfix))))
+
+    (fill-region-as-paragraph from to justify)
+
+    ;;  Add the postfixes if required
+    (if postfix
+        (save-restriction
+          (goto-char from)
+          (narrow-to-region from to)
+          (while (not (eobp))
+            (end-of-line)
+            (insert-char ?  (- fill-column (current-column)))
+            (insert ada-fill-comment-postfix)
+            (forward-line))
+          ))
 
+    ;;  In Emacs <= 20.2 and XEmacs <=20.4, there is a bug, and a newline is
+    ;;  inserted at the end. Delete it
+    (if (or (featurep 'xemacs)
+            (<= emacs-major-version 19)
+            (and (= emacs-major-version 20)
+                 (<= emacs-minor-version 2)))
+        (progn
+          (goto-char to)
+          (end-of-line)
+          (delete-char 1)))
+
+    (goto-char opos)))
+
+
+;; ---------------------------------------------------
+;;    support for find-file.el
+;; These functions are used by find-file to guess the file names from
+;; unit names, and to find the other file (spec or body) from the current
+;; file (body or spec).
+;; It is also used to find in which function we are, so as to put the
+;; cursor at the correct position.
+;; Standard Ada does not force any relation between unit names and file names,
+;; so some of these functions can only be a good approximation. However, they
+;; are also overriden in `ada-xref'.el when we know that the user is using
+;; GNAT.
+;; ---------------------------------------------------
+
+;; Overriden when we work with GNAT, to use gnatkrunch
 (defun ada-make-filename-from-adaname (adaname)
-  "determine the filename of a package/procedure from its own Ada name."
-  ;; this is done simply by calling gkrunch, when we work with GNAT. It
-  ;; must be a more complex function in other compiler environments.
-  (interactive "s")
-
-  ;; things that should really be done by the external process
-  (let (krunch-buf)
-    (setq krunch-buf (generate-new-buffer "*gkrunch*"))
-    (save-excursion
-      (set-buffer krunch-buf)
-      (insert (downcase adaname))
-      (goto-char (point-min))
-      (while (search-forward "." nil t)
-        (replace-match "-" nil t))
-      (setq adaname (buffer-substring (point-min)
-                                      (progn
-                                        (goto-char (point-min))
-                                        (end-of-line)
-                                        (point))))
-      ;; clean the buffer
-      (delete-region (point-min) (point-max))
-      ;; send adaname to external process "gnatk8"
-      (call-process "gnatk8" nil krunch-buf nil
-                    adaname ada-krunch-args)
-      ;; fetch output of that process
-      (setq adaname (buffer-substring
-                     (point-min)
-                     (progn
-                       (goto-char (point-min))
-                       (end-of-line)
-                       (point))))
-      (kill-buffer krunch-buf)))
-  (setq adaname adaname) ;; can I avoid this statement?
+  "Determine the filename in which ADANAME is found.
+This is a generic function, independent from any compiler."
+  (while (string-match "\\." adaname)
+    (setq adaname (replace-match "-" t t adaname)))
+  (downcase adaname)
   )
 
-;;;---------------------------------------------------
-;;; support for imenu
-;;;---------------------------------------------------
+(defun ada-other-file-name ()
+  "Return the name of the other file.
+The name returned is the body if current-buffer is the spec, or the spec
+otherwise."
+
+  (let ((is-spec nil)
+	(is-body nil)
+	(suffixes ada-spec-suffixes)
+	(name  (buffer-file-name)))
+
+    ;;  Guess whether we have a spec or a body, and get the basename of the
+    ;;  file. Since the extension may not start with '.', we can not use
+    ;;  file-name-extension
+    (while (and (not is-spec)
+		suffixes)
+      (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name)
+	  (setq is-spec t
+		name    (match-string 1 name)))
+      (setq suffixes (cdr suffixes)))
+
+    (if (not is-spec)
+	(progn
+	  (setq suffixes ada-body-suffixes)
+	  (while (and (not is-body)
+		      suffixes)
+	    (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name)
+		(setq is-body t
+		      name    (match-string 1 name)))
+	    (setq suffixes (cdr suffixes)))))
+
+    ;;  If this wasn't in either list, return name itself
+    (if (not (or is-spec is-body))
+	name
+
+      ;;  Else find the other possible names
+      (if is-spec
+	  (setq suffixes ada-body-suffixes)
+	(setq suffixes ada-spec-suffixes))
+      (setq is-spec name)
+
+      (while suffixes
+
+	;;  If we are using project file, search for the other file in all
+	;;  the possible src directories.
+
+	(if (fboundp 'ada-find-src-file-in-dir)
+	    (let ((other
+		   (ada-find-src-file-in-dir
+		    (file-name-nondirectory (concat name (car suffixes))))))
+	      (if other
+		  (set 'is-spec other)))
+
+	  ;;  Else search in the current directory
+	  (if (file-exists-p (concat name (car suffixes)))
+	      (setq is-spec (concat name (car suffixes)))))
+	(setq suffixes (cdr suffixes)))
+
+      is-spec)))
+
+(defun ada-which-function-are-we-in ()
+  "Return the name of the function whose definition/declaration point is in.
+Redefines the function `ff-which-function-are-we-in'."
+  (setq ff-function-name nil)
+  (save-excursion
+    (end-of-line);;  make sure we get the complete name
+    (if (or (re-search-backward ada-procedure-start-regexp nil t)
+            (re-search-backward ada-package-start-regexp nil t))
+        (setq ff-function-name (match-string 0)))
+    ))
 
-(defun imenu-create-ada-index (&optional regexp)
-  "create index alist for Ada files."
-  (let ((index-alist '())
-        prev-pos char)
-    (goto-char (point-min))
-    ;(imenu-progress-message prev-pos 0)
-    ;; Search for functions/procedures
-    (save-match-data
-     (while (re-search-forward
-             (or regexp ada-procedure-start-regexp)
-             nil t)
-       ;(imenu-progress-message prev-pos)
-       ;;(backward-up-list 1) ;; needed in Ada ????
-       ;; do not store forward definitions
-       (save-match-data
-        (if (not (looking-at (concat
-                              "[ \t\n]*" ; WS
-                              "\([^)]+\)" ; parameterlist
-                              "\\([ \n\t]+return[ \n\t]+"; potential return
-                              "[a-zA-Z0-9_\\.]+\\)?"
-                              "[ \t]*" ; WS
-                              ";"  ;; THIS is what we really look for
-                              )))
-            ; (push (imenu-example--name-and-position) index-alist)
-            (setq index-alist (cons (imenu-example--name-and-position)
-                        index-alist))
-          ))
-       ;(imenu-progress-message 100)
-       ))
-    (nreverse index-alist)))
 
-;;;---------------------------------------------------
-;;; support for font-lock
-;;;---------------------------------------------------
+(defvar ada-last-which-function-line -1
+  "Last on which ada-which-function was called")
+(defvar ada-last-which-function-subprog 0
+  "Last subprogram name returned by ada-which-function")
+(make-variable-buffer-local 'ada-last-which-function-subprog)
+(make-variable-buffer-local 'ada-last-which-function-line)
 
-;; Strings are a real pain in Ada because both ' and " can appear in a
-;; non-string quote context (the former as an operator, the latter as
-;; a character string).  We follow the least losing solution, in which
-;; only " is a string quote.  Therefore a character string of the form
-;; '"' will throw fontification off on the wrong track.
 
-(defconst ada-font-lock-keywords-1
-  (list
-   ;;
-   ;; Function, package (body), pragma, procedure, task (body) plus name.
-   (list (concat "\\<\\("
-                 "function\\|"
-                 "p\\(ackage\\(\\|[ \t]+body\\)\\|r\\(agma\\|ocedure\\)\\)\\|"
-                 "task\\(\\|[ \t]+body\\)"
-                 "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
-         '(1 font-lock-keyword-face) '(6 font-lock-function-name-face nil t)))
-  "For consideration as a value of `ada-font-lock-keywords'.
-This does fairly subdued highlighting.")
-
-(defconst ada-font-lock-keywords-2
-  (append ada-font-lock-keywords-1
-   (list
-    ;;
-    ;; Main keywords, except those treated specially below.
-    (concat "\\<\\("
-;    ("abort" "abs" "abstract" "accept" "access" "aliased" "all"
-;     "and" "array" "at" "begin" "case" "declare" "delay" "delta"
-;     "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
-;     "generic" "if" "in" "is" "limited" "loop" "mod" "not"
-;     "null" "or" "others" "private" "protected"
-;     "range" "record" "rem" "renames" "requeue" "return" "reverse"
-;     "select" "separate" "tagged" "task" "terminate" "then" "until"
-;     "while" "xor")
-            "a\\(b\\(ort\\|s\\(\\|tract\\)\\)\\|cce\\(pt\\|ss\\)\\|"
-            "l\\(iased\\|l\\)\\|nd\\|rray\\|t\\)\\|begin\\|case\\|"
-            "d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|"
-            "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|"
-            "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|"
-            "o\\(r\\|thers\\|ut\\)\\|pr\\(ivate\\|otected\\)\\|"
-            "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|"
-            "se\\(lect\\|parate\\)\\|"
-            "t\\(a\\(gged\\|sk\\)\\|erminate\\|hen\\)\\|until\\|while\\|xor"
-            "\\)\\>")
-    ;;
-    ;; Anything following end and not already fontified is a body name.
-    '("\\<\\(end\\)\\>[ \t]*\\(\\sw+\\)?"
-      (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
-    ;;
-    ;; Variable name plus optional keywords followed by a type name.  Slow.
-;    (list (concat "\\<\\(\\sw+\\)\\>[ \t]*:?[ \t]*"
-;                 "\\(access\\|constant\\|in\\|in[ \t]+out\\|out\\)?[ \t]*"
-;                 "\\(\\sw+\\)?")
-;         '(1 font-lock-variable-name-face)
-;         '(2 font-lock-keyword-face nil t) '(3 font-lock-type-face nil t))
-    ;;
-    ;; Optional keywords followed by a type name.
-    (list (concat ; ":[ \t]*"
-                  "\\<\\(access\\|constant\\|in\\|in[ \t]+out\\|out\\)\\>"
-                  "[ \t]*"
-                  "\\(\\sw+\\)?")
-          '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
-    ;;
-    ;; Keywords followed by a type or function name.
-    (list (concat "\\<\\("
-                  "new\\|of\\|subtype\\|type"
-                  "\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*\\((\\)?")
-          '(1 font-lock-keyword-face)
-          '(2 (if (match-beginning 4)
-                  font-lock-function-name-face
-                font-lock-type-face) nil t))
-    ;;
-    ;; Keywords followed by a (comma separated list of) reference.
-    (list (concat "\\<\\(goto\\|raise\\|use\\|when\\|with\\)\\>"
-                  ; "[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?") ; RE
-                  "[ \t]*\\([a-zA-Z0-9_\\.\\|, ]+\\)\\W")
-          '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
-    ;;
-    ;; Goto tags.
-    '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face)
+(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.
+Since the search can be long, the results are cached."
+
+  (let ((line (count-lines 1 (point)))
+        (pos (point))
+        end-pos
+        func-name indent
+        found)
+
+    ;;  If this is the same line as before, simply return the same result
+    (if (= line ada-last-which-function-line)
+        ada-last-which-function-subprog
+
+      (save-excursion
+        ;; In case the current line is also the beginning of the body
+        (end-of-line)
+
+	;;  Are we looking at "function Foo\n    (paramlist)"
+	(skip-chars-forward " \t\n(")
+
+	(condition-case nil
+	    (up-list 1)
+	  (error nil))
+
+	(skip-chars-forward " \t\n")
+	(if (looking-at "return")
+	    (progn
+	      (forward-word 1)
+	      (skip-chars-forward " \t\n")
+	      (skip-chars-forward "a-zA-Z0-9_'")))
+
+        ;; Can't simply do forward-word, in case the "is" is not on the
+        ;; same line as the closing parenthesis
+        (skip-chars-forward "is \t\n")
+
+        ;; No look for the closest subprogram body that has not ended yet.
+        ;; Not that we expect all the bodies to be finished by "end <name>",
+        ;; 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))
+
+	  ;; Get the function name, but not the properties, or this changes
+	  ;; the face in the modeline on Emacs 21
+          (setq func-name (match-string-no-properties 2))
+          (if (and (not (ada-in-comment-p))
+                   (not (save-excursion
+                          (goto-char (match-end 0))
+                          (looking-at "[ \t\n]*new"))))
+              (save-excursion
+		(back-to-indentation)
+		(setq indent (current-column))
+                (if (ada-search-ignore-string-comment
+                     (concat "end[ \t]+" func-name "[ \t]*;\\|^"
+			     (make-string indent ? ) "end;"))
+                    (setq end-pos (point))
+                  (setq end-pos (point-max)))
+                (if (>= end-pos pos)
+                    (setq found func-name))))
+          )
+        (setq ada-last-which-function-line line
+              ada-last-which-function-subprog found)
+        found))))
+
+(defun ada-ff-other-window ()
+  "Find other file in other window using `ff-find-other-file'."
+  (interactive)
+  (and (fboundp 'ff-find-other-file)
+       (ff-find-other-file t)))
+
+(defun ada-set-point-accordingly ()
+  "Move to the function declaration that was set by
+`ff-which-function-are-we-in'."
+  (if ff-function-name
+      (progn
+        (goto-char (point-min))
+        (unless (ada-search-ignore-string-comment
+                 (concat ff-function-name "\\b") nil)
+          (goto-char (point-min))))))
+
+(defun ada-get-body-name (&optional spec-name)
+  "Returns the file name for the body of SPEC-NAME.
+If SPEC-NAME is nil, returns the body for the current package.
+Returns nil if no body was found."
+  (interactive)
+
+  (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 (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-body-suffixes)
+    ;; Else emulate it very simply
+    (concat (ada-make-filename-from-adaname
+             (file-name-nondirectory
+              (file-name-sans-extension spec-name)))
+            ".adb")))
+
+
+;; ---------------------------------------------------
+;;    support for font-lock.el
+;; Strings are a real pain in Ada because a single quote character is
+;; overloaded as a string quote and type/instance delimiter.  By default, a
+;; single quote is given punctuation syntax in `ada-mode-syntax-table'.
+;; So, for Font Lock mode purposes, we mark single quotes as having string
+;; syntax when the gods that created Ada determine them to be.
+;;
+;; This only works in Emacs. See the comments before the grammar functions
+;; at the beginning of this file for how this is done with XEmacs.
+;; ----------------------------------------------------
+
+(defconst ada-font-lock-syntactic-keywords
+  ;; Mark single quotes as having string quote syntax in 'c' instances.
+  ;; As a special case, ''' will not be highlighted, but if we do not
+  ;; set this special case, then the rest of the buffer is highlighted as
+  ;; a string
+  ;; This sets the properties of the characters, so that ada-in-string-p
+  ;; correctly handles '"' too...
+  '(("[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
+    ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))
     ))
-  "For consideration as a value of `ada-font-lock-keywords'.
-This does a lot more highlighting.")
 
-(defvar ada-font-lock-keywords (if font-lock-maximum-decoration
-				   ada-font-lock-keywords-2
-				 ada-font-lock-keywords-1)
-  "*Expressions to highlight in Ada mode.")
+(defvar ada-font-lock-keywords
+  (eval-when-compile
+    (list
+     ;;
+     ;; handle "type T is access function return S;"
+     (list "\\<\\(function[ \t]+return\\)\\>" '(1 font-lock-keyword-face) )
 
-;;;
-;;; ????
-;;;
-(defun ada-gen-comment-until-proc ()
-  ;; comment until spec of a procedure or a function.
-  (forward-line 1)
-  (set-mark-command (point))
-  (if (re-search-forward ada-procedure-start-regexp nil t)
-      (progn (goto-char (match-beginning 1))
-             (comment-region (mark) (point)))
-    (error "No more functions/procedures")))
-
-
-(defun ada-gen-treat-proc nil
-  ;; make dummy body of a procedure/function specification.
-  (goto-char (match-end 0))
-  (let ((wend (point))
-        (wstart (progn (re-search-backward "[   ][a-zA-Z0-9_\"]+" nil t)
-                       (+ (match-beginning 0) 1)))) ; delete leading WS
-    (copy-region-as-kill wstart wend) ; store  proc name in kill-buffer
-
-
-    ;; if the next notWS char is '(' ==> parameterlist follows
-    ;; if the next notWS char is ';' ==> no paramterlist
-    ;; if the next notWS char is 'r' ==> paramterless function, search ';'
-
-    ;; goto end of regex before last (= end of procname)
-    (goto-char (match-end 0))
-    ;; look for next non WS
-    (backward-char)
-    (re-search-forward "[       ]*.")
-    (if (char-equal (char-after (match-end 0)) ?\;)
-        (delete-char 1) ;; delete the ';'
-      ;; else
-      ;; find ');' or 'return <id> ;'
-      (re-search-forward
-       "\\()[ \t]*;\\)\\|\\(return[ \t]+[a-zA-Z0-9_]+[ \t]*;\\)" nil t)
-      (goto-char (match-end 0))
-      (delete-backward-char 1) ;; delete the ';'
-      )
+     ;;  preprocessor line
+     (list "^[ \t]*\\(#.*\n\\)"  '(1 font-lock-type-face t))
 
-    (insert " is")
-    ;; if it is a function, we should generate a return variable and a
-    ;; return statement. Sth. like "Result : <return-type>;" and a
-    ;; "return Result;".
-    (ada-indent-newline-indent)
-    (insert "begin -- ")
-    (yank)
-    (newline)
-    (insert "null;")
-    (newline)
-    (insert "end ")
-    (yank)
-    (insert ";")
-    (ada-indent-newline-indent))
-
-
-(defun ada-gen-make-bodyfile (spec-filename)
-  "Create a new buffer containing the correspondig Ada body
-to the current specs."
-  (interactive "b")
-;;;  (let* (
-;;;      (file-name (ada-body-filename spec-filename))
-;;;      (buf (get-buffer-create file-name)))
-;;;    (switch-to-buffer buf)
-;;;    (ada-mode)
-  (ff-find-other-file t t)
-;;;  (if (= (buffer-size) 0)
-;;;      (make-header)
-;;;    ;; make nothing, autoinsert.el had put something in already
-;;;    )
-    (end-of-buffer)
-    (let ((hlen (count-lines (point-min) (point-max))))
-      (insert-buffer spec-filename)
-      ;; hlen lines have already been inserted automatically
-      )
+     ;;
+     ;; accept, entry, function, package (body), protected (body|type),
+     ;; pragma, procedure, task (body) plus name.
+     (list (concat
+            "\\<\\("
+            "accept\\|"
+            "entry\\|"
+            "function\\|"
+            "package[ \t]+body\\|"
+            "package\\|"
+            "pragma\\|"
+            "procedure\\|"
+            "protected[ \t]+body\\|"
+            "protected[ \t]+type\\|"
+            "protected\\|"
+            "task[ \t]+body\\|"
+            "task[ \t]+type\\|"
+            "task"
+            "\\)\\>[ \t]*"
+            "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
+           '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t))
+     ;;
+     ;; Optional keywords followed by a type name.
+     (list (concat                      ; ":[ \t]*"
+            "\\<\\(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))
+
+     ;;
+     ;; Main keywords, except those treated specially below.
+     (concat "\\<"
+             (regexp-opt
+              '("abort" "abs" "abstract" "accept" "access" "aliased" "all"
+                "and" "array" "at" "begin" "case" "declare" "delay" "delta"
+                "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
+                "generic" "if" "in" "is" "limited" "loop" "mod" "not"
+                "null" "or" "others" "private" "protected" "raise"
+                "range" "record" "rem" "renames" "requeue" "return" "reverse"
+                "select" "separate" "tagged" "task" "terminate" "then" "until"
+                "when" "while" "with" "xor") t)
+             "\\>")
+     ;;
+     ;; Anything following end and not already fontified is a body name.
+     '("\\<\\(end\\)\\>\\([ \t]+\\)?\\(\\(\\sw\\|[_.]\\)+\\)?"
+       (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
+     ;;
+     ;; Keywords followed by a type or function name.
+     (list (concat "\\<\\("
+                   "new\\|of\\|subtype\\|type"
+                   "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?")
+           '(1 font-lock-keyword-face)
+           '(2 (if (match-beginning 4)
+                   font-lock-function-name-face
+                 font-lock-type-face) nil t))
+     ;;
+     ;; Keywords followed by a (comma separated list of) reference.
+     ;; Note that font-lock only works on single lines, thus we can not
+     ;; correctly highlight a with_clause that spans multiple lines.
+     (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)"
+                   "[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W")
+           '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
+
+     ;;
+     ;; Goto tags.
+     '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face)
+
+     ;; Highlight based-numbers (R. Reagan <robin-reply@reagans.org>)
+     (list "\\([0-9]+#[0-9a-fA-F_]+#\\)" '(1 font-lock-constant-face t))
+
+     ;; Ada unnamed numerical constants
+     (list "\\W\\([-+]?[0-9._]+\\)\\>" '(1 font-lock-constant-face))
+
+     ))
+  "Default expressions to highlight in Ada mode.")
+
+
+;; ---------------------------------------------------------
+;;  Support for outline.el
+;; ---------------------------------------------------------
+
+(defun ada-outline-level ()
+  "This is so that `current-column` DTRT in otherwise-hidden text"
+  ;; patch from Dave Love <fx@gnu.org>
+  (let (buffer-invisibility-spec)
+    (save-excursion
+      (back-to-indentation)
+      (current-column))))
+
+;; ---------------------------------------------------------
+;;  Support for narrow-to-region
+;; ---------------------------------------------------------
+
+(defun ada-narrow-to-defun (&optional arg)
+  "make text outside current subprogram invisible.
+The subprogram visible is the one that contains or follow point.
+Optional ARG is ignored.
+Use `M-x widen' to go back to the full visibility for the buffer"
+
+  (interactive)
+  (save-excursion
+    (let (end)
+      (widen)
+      (forward-line 1)
+      (ada-previous-procedure)
+
+      (save-excursion
+        (beginning-of-line)
+        (setq end (point)))
+
+      (ada-move-to-end)
+      (end-of-line)
+      (narrow-to-region end (point))
+      (message
+       "Use M-x widen to get back to full visibility in the buffer"))))
+
+;; ---------------------------------------------------------
+;;    Automatic generation of code
+;; The Ada-mode has a set of function to automatically generate a subprogram
+;; or package body from its spec.
+;; These function only use a primary and basic algorithm, this could use a
+;; lot of improvement.
+;; When the user is using GNAT, we rather use gnatstub to generate an accurate
+;; body.
+;; ----------------------------------------------------------
+
+(defun ada-gen-treat-proc (match)
+  "Make dummy body of a procedure/function specification.
+MATCH is a cons cell containing the start and end location of the last search
+for ada-procedure-start-regexp."
+  (goto-char (car match))
+  (let (func-found procname functype)
+    (cond
+     ((or (looking-at "^[ \t]*procedure")
+          (setq func-found (looking-at "^[ \t]*function")))
+      ;; treat it as a proc/func
+      (forward-word 2)
+      (forward-word -1)
+      (setq procname (buffer-substring (point) (cdr match))) ; store  proc name
+
+      ;; goto end of procname
+      (goto-char (cdr match))
+
+      ;; skip over parameterlist
+      (unless (looking-at "[ \t\n]*\\(;\\|return\\)")
+        (forward-sexp))
 
-    (if (re-search-forward ada-package-start-regexp nil t)
-        (progn (goto-char (match-end 1))
-               (insert " body"))
+      ;; if function, skip over 'return' and result type.
+      (if func-found
+          (progn
+            (forward-word 1)
+            (skip-chars-forward " \t\n")
+            (setq functype (buffer-substring (point)
+                                             (progn
+                                               (skip-chars-forward
+                                                "a-zA-Z0-9_\.")
+                                               (point))))))
+      ;; look for next non WS
+      (cond
+       ((looking-at "[ \t]*;")
+        (delete-region (match-beginning 0) (match-end 0));; delete the ';'
+        (ada-indent-newline-indent)
+        (insert "is")
+        (ada-indent-newline-indent)
+        (if func-found
+            (progn
+              (insert "Result : " functype ";")
+              (ada-indent-newline-indent)))
+        (insert "begin")
+        (ada-indent-newline-indent)
+        (if func-found
+            (insert "return Result;")
+          (insert "null;"))
+        (ada-indent-newline-indent)
+        (insert "end " procname ";")
+        (ada-indent-newline-indent)
+        )
+       ;; else
+       ((looking-at "[ \t\n]*is")
+        ;; do nothing
+        )
+       ((looking-at "[ \t\n]*rename")
+        ;; do nothing
+        )
+       (t
+        (message "unknown syntax"))))
+     (t
+      (if (looking-at "^[ \t]*task")
+          (progn
+            (message "Task conversion is not yet implemented")
+            (forward-word 2)
+            (if (looking-at "[ \t]*;")
+                (forward-line)
+              (ada-move-to-end))
+            ))))))
+
+(defun ada-make-body ()
+  "Create an Ada package body in the current buffer.
+The potential old buffer contents is deleted first, then we copy the
+spec buffer in here and modify it to make it a body.
+This function typically is to be hooked into `ff-file-created-hooks'."
+  (interactive)
+  (delete-region (point-min) (point-max))
+  (insert-buffer (car (cdr (buffer-list))))
+  (ada-mode)
+
+  (let (found ada-procedure-or-package-start-regexp)
+    (if (setq found
+             (ada-search-ignore-string-comment ada-package-start-regexp nil))
+        (progn (goto-char (cdr found))
+               (insert " body")
+               )
       (error "No package"))
-                                        ; (comment-until-proc)
-                                        ; does not work correctly
-                                        ; must be done by hand
-
-    (while (re-search-forward ada-procedure-start-regexp nil t)
-      (ada-gen-treat-proc))
-
-                                        ; don't overwrite an eventually
-                                        ; existing file
-;    (if (file-exists-p file-name)
-;        (error "File with this name already exists!")
-;      (write-file file-name))
-    ))
 
-;;; provide ourself
+    (setq ada-procedure-or-package-start-regexp
+         (concat ada-procedure-start-regexp
+                 "\\|"
+                 ada-package-start-regexp))
+
+    (while (setq found
+                (ada-search-ignore-string-comment
+                 ada-procedure-or-package-start-regexp nil))
+      (progn
+        (goto-char (car found))
+        (if (looking-at ada-package-start-regexp)
+            (progn (goto-char (cdr found))
+                   (insert " body"))
+          (ada-gen-treat-proc found))))))
+
+
+(defun ada-make-subprogram-body ()
+  "Make one dummy subprogram body from spec surrounding point."
+  (interactive)
+  (let* ((found (re-search-backward ada-procedure-start-regexp nil t))
+         (spec  (match-beginning 0))
+         body-file)
+    (if found
+        (progn
+          (goto-char spec)
+          (if (and (re-search-forward "(\\|;" nil t)
+                   (= (char-before) ?\())
+              (progn
+                (ada-search-ignore-string-comment ")" nil)
+                (ada-search-ignore-string-comment ";" nil)))
+          (setq spec (buffer-substring spec (point)))
+
+          ;; If find-file.el was available, use its functions
+          (setq body-file (ada-get-body-name))
+          (if body-file
+              (find-file body-file)
+            (error "No body found for the package. Create it first."))
+
+          (save-restriction
+            (widen)
+            (goto-char (point-max))
+            (forward-comment -10000)
+            (re-search-backward "\\<end\\>" nil t)
+            ;;  Move to the beginning of the elaboration part, if any
+            (re-search-backward "^begin" nil t)
+            (newline)
+            (forward-char -1)
+            (insert spec)
+            (re-search-backward ada-procedure-start-regexp nil t)
+            (ada-gen-treat-proc (cons (match-beginning 0) (match-end 0)))
+            ))
+      (error "Not in subprogram spec"))))
+
+;; --------------------------------------------------------
+;; Global initializations
+;; --------------------------------------------------------
+
+;;  Create the keymap once and for all. If we do that in ada-mode,
+;;  the keys changed in the user's .emacs have to be modified
+;;  every time
+(ada-create-keymap)
+(ada-create-menu)
+
+;;  Create the syntax tables, but do not activate them
+(ada-create-syntax-table)
+
+;;  Add the default extensions (and set up speedbar)
+(ada-add-extensions ".ads" ".adb")
+;; This two files are generated by GNAT when running with -gnatD
+(if (equal ada-which-compiler 'gnat)
+    (ada-add-extensions ".ads.dg" ".adb.dg"))
+
+;;  Read the special cases for exceptions
+(ada-case-read-exceptions)
+
+;;  Setup auto-loading of the other ada-mode files.
+(if (equal ada-which-compiler 'gnat)
+    (progn
+      (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)
+      ))
 
+(autoload 'ada-array           "ada-stmt" nil t)
+(autoload 'ada-case            "ada-stmt" nil t)
+(autoload 'ada-declare-block   "ada-stmt" nil t)
+(autoload 'ada-else            "ada-stmt" nil t)
+(autoload 'ada-elsif           "ada-stmt" nil t)
+(autoload 'ada-exception       "ada-stmt" nil t)
+(autoload 'ada-exception-block "ada-stmt" nil t)
+(autoload 'ada-exit            "ada-stmt" nil t)
+(autoload 'ada-for-loop        "ada-stmt" nil t)
+(autoload 'ada-function-spec   "ada-stmt" nil t)
+(autoload 'ada-header          "ada-stmt" nil t)
+(autoload 'ada-if              "ada-stmt" nil t)
+(autoload 'ada-loop            "ada-stmt" nil t)
+(autoload 'ada-package-body    "ada-stmt" nil t)
+(autoload 'ada-package-spec    "ada-stmt" nil t)
+(autoload 'ada-private         "ada-stmt" nil t)
+(autoload 'ada-procedure-spec  "ada-stmt" nil t)
+(autoload 'ada-record          "ada-stmt" nil t)
+(autoload 'ada-subprogram-body "ada-stmt" nil t)
+(autoload 'ada-subtype         "ada-stmt" nil t)
+(autoload 'ada-tabsize         "ada-stmt" nil t)
+(autoload 'ada-task-body       "ada-stmt" nil t)
+(autoload 'ada-task-spec       "ada-stmt" nil t)
+(autoload 'ada-type            "ada-stmt" nil t)
+(autoload 'ada-use             "ada-stmt" nil t)
+(autoload 'ada-when            "ada-stmt" nil t)
+(autoload 'ada-while-loop      "ada-stmt" nil t)
+(autoload 'ada-with            "ada-stmt" nil t)
+
+;;; provide ourselves
 (provide 'ada-mode)
 
+;;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270
 ;;; ada-mode.el ends here