]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/ada-xref.el
delx.au / code / gnu-emacs / blobdiff
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
(compilation-start): Rely on `cd' to get dir right and also allow argumentless cd.
[gnu-emacs] / lisp / progmodes / ada-xref.el
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index 5cf2c2e75b9a1e3b4a31d907f70f7589023acb34..fc1d2d46ab37b7cbabca94b56410841100f12e74 100644 (file)
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -1,13 +1,13 @@
 ;;; ada-xref.el --- for lookup and completion in Ada mode
 
 ;;; ada-xref.el --- for lookup and completion in Ada mode
 
-;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002, 2003
 ;;    Free Software Foundation, Inc.
 
 ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
 ;;      Rolf Ebert <ebert@inf.enst.fr>
 ;;      Emmanuel Briot <briot@gnat.com>
 ;; Maintainer: Emmanuel Briot <briot@gnat.com>
 ;;    Free Software Foundation, Inc.
 
 ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
 ;;      Rolf Ebert <ebert@inf.enst.fr>
 ;;      Emmanuel Briot <briot@gnat.com>
 ;; Maintainer: Emmanuel Briot <briot@gnat.com>
-;; Ada Core Technologies's version:   $Revision: 1.150 $
+;; Ada Core Technologies's version:   Revision: 1.181
 ;; Keywords: languages ada xref
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: languages ada xref
 
 ;; This file is part of GNU Emacs.
@@ -33,7 +33,7 @@
 ;;; for lookup and completion in Ada mode.
 ;;;
 ;;; If a file *.`adp' exists in the ada-file directory, then it is
 ;;; for lookup and completion in Ada mode.
 ;;;
 ;;; If a file *.`adp' exists in the ada-file directory, then it is
-;;; read for configuration informations. It is read only the first
+;;; read for configuration informations.  It is read only the first
 ;;; time a cross-reference is asked for, and is not read later.
 
 ;;; You need Emacs >= 20.2 to run this package
 ;;; time a cross-reference is asked for, and is not read later.
 
 ;;; You need Emacs >= 20.2 to run this package
@@ -44,6 +44,8 @@
 
 (require 'compile)
 (require 'comint)
 
 (require 'compile)
 (require 'comint)
+(require 'find-file)
+(require 'ada-mode)
 
 ;; ------ Use variables
 (defcustom ada-xref-other-buffer t
 
 ;; ------ Use variables
 (defcustom ada-xref-other-buffer t
@@ -51,21 +53,30 @@
 Otherwise create either a new buffer or a new frame."
   :type 'boolean :group 'ada)
 
 Otherwise create either a new buffer or a new frame."
   :type 'boolean :group 'ada)
 
-(defcustom ada-xref-create-ali t
+(defcustom ada-xref-create-ali nil
   "*If non-nil, run gcc whenever the cross-references are not up-to-date.
   "*If non-nil, run gcc whenever the cross-references are not up-to-date.
-If nil, the cross-reference mode will never run gcc."
+If nil, the cross-reference mode never runs gcc."
   :type 'boolean :group 'ada)
 
 (defcustom ada-xref-confirm-compile nil
   :type 'boolean :group 'ada)
 
 (defcustom ada-xref-confirm-compile nil
-  "*If non-nil, always ask for user confirmation before compiling or running
-the application."
+  "*If non-nil, ask for confirmation before compiling or running the application."
   :type 'boolean :group 'ada)
 
 (defcustom ada-krunch-args "0"
   :type 'boolean :group 'ada)
 
 (defcustom ada-krunch-args "0"
-  "*Maximum number of characters for filenames created by gnatkr.
-Set to 0, if you don't use crunched filenames. This should be a string."
+  "*Maximum number of characters for filenames created by `gnatkr'.
+Set to 0, if you don't use crunched filenames.  This should be a string."
   :type 'string :group 'ada)
 
   :type 'string :group 'ada)
 
+(defcustom ada-gnatls-args '("-v")
+  "*Arguments to pass to `gnatfind' to find location of the runtime.
+Typical use is to pass `--RTS=soft-floats' on some systems that support it.
+
+You can also add `-I-' if you do not want the current directory to be included.
+Otherwise, going from specs to bodies and back will first look for files in the
+current directory.  This only has an impact if you are not using project files,
+but only ADA_INCLUDE_PATH."
+  :type '(repeat string) :group 'ada)
+
 (defcustom ada-prj-default-comp-opt "-gnatq -gnatQ"
   "Default compilation options."
   :type 'string :group 'ada)
 (defcustom ada-prj-default-comp-opt "-gnatq -gnatQ"
   "Default compilation options."
   :type 'string :group 'ada)
@@ -79,26 +90,27 @@ Set to 0, if you don't use crunched filenames. This should be a string."
   :type 'string :group 'ada)
 
 (defcustom ada-prj-default-gnatmake-opt "-g"
   :type 'string :group 'ada)
 
 (defcustom ada-prj-default-gnatmake-opt "-g"
-  "Default options for gnatmake."
+  "Default options for `gnatmake'."
   :type 'string :group 'ada)
 
 (defcustom ada-prj-gnatfind-switches "-rf"
   :type 'string :group 'ada)
 
 (defcustom ada-prj-gnatfind-switches "-rf"
-  "Default switches to use for gnatfind.
-You should modify this variable, for instance to add -a, if you are working
+  "Default switches to use for `gnatfind'.
+You should modify this variable, for instance to add `-a', if you are working
 in an environment where most ALI files are write-protected.
 in an environment where most ALI files are write-protected.
-The command gnatfind is used every time you choose the menu
+The command `gnatfind' is used every time you choose the menu
 \"Show all references\"."
   :type 'string :group 'ada)
 
 (defcustom ada-prj-default-comp-cmd
 \"Show all references\"."
   :type 'string :group 'ada)
 
 (defcustom ada-prj-default-comp-cmd
-  "${cross_prefix}gcc -x ada -c ${comp_opt} ${full_current}"
+  (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
+         " ${comp_opt}")
   "*Default command to be used to compile a single file.
   "*Default command to be used to compile a single file.
-Emacs will add the filename at the end of this command. This is the same
+Emacs will add the filename at the end of this command.  This is the same
 syntax as in the project file."
   :type 'string :group 'ada)
 
 (defcustom ada-prj-default-debugger "${cross_prefix}gdb"
 syntax as in the project file."
   :type 'string :group 'ada)
 
 (defcustom ada-prj-default-debugger "${cross_prefix}gdb"
-  "*Default name of the debugger. We recommend either `gdb',
+  "*Default name of the debugger.  We recommend either `gdb',
 `gdb --emacs_gdbtk' or `ddd --tty -fullname'."
   :type 'string :group 'ada)
 
 `gdb --emacs_gdbtk' or `ddd --tty -fullname'."
   :type 'string :group 'ada)
 
@@ -116,7 +128,7 @@ this string is not empty."
   :type '(file :must-match t) :group 'ada)
 
 (defcustom ada-gnatstub-opts "-q -I${src_dir}"
   :type '(file :must-match t) :group 'ada)
 
 (defcustom ada-gnatstub-opts "-q -I${src_dir}"
-  "*List of the options to pass to gnatsub to generate the body of a package.
+  "*List of the options to pass to `gnatsub' to generate the body of a package.
 This has the same syntax as in the project file (with variable substitution)."
   :type 'string :group 'ada)
 
 This has the same syntax as in the project file (with variable substitution)."
   :type 'string :group 'ada)
 
@@ -126,11 +138,32 @@ Otherwise, ask the user for the name of the project file to use."
   :type 'boolean :group 'ada)
 
 (defconst is-windows (memq system-type (quote (windows-nt)))
   :type 'boolean :group 'ada)
 
 (defconst is-windows (memq system-type (quote (windows-nt)))
-  "True if we are running on windows NT or windows 95.")
+  "True if we are running on Windows NT or Windows 95.")
 
 (defcustom ada-tight-gvd-integration nil
   "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
 
 (defcustom ada-tight-gvd-integration nil
   "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
-If GVD is not the debugger used, nothing happens.")
+If GVD is not the debugger used, nothing happens."
+  :type 'boolean :group 'ada)
+
+(defcustom ada-xref-search-with-egrep t
+  "*If non-nil, use egrep to find the possible declarations for an entity.
+This alternate method is used when the exact location was not found in the
+information provided by GNAT.  However, it might be expensive if you have a lot
+of sources, since it will search in all the files in your project."
+  :type 'boolean :group 'ada)
+
+(defvar ada-load-project-hook nil
+  "Hook that is run when loading a project file.
+Each function in this hook takes one argument FILENAME, that is the name of
+the project file to load.
+This hook should be used to support new formats for the project files.
+
+If the function can load the file with the given filename, it should create a
+buffer that contains a conversion of the file to the standard format of the
+project files, and return that buffer.  (The usual \"src_dir=\" or \"obj_dir=\"
+lines.)  It should return nil if it doesn't know how to convert that project
+file.")
+
 
 ;; ------- Nothing to be modified by the user below this
 (defvar ada-last-prj-file ""
 
 ;; ------- Nothing to be modified by the user below this
 (defvar ada-last-prj-file ""
@@ -158,14 +191,13 @@ Used to go back to these positions.")
   (if (string-match "cmdproxy.exe" shell-file-name)
       "cd /d"
     "cd")
   (if (string-match "cmdproxy.exe" shell-file-name)
       "cd /d"
     "cd")
-  "Command to use to change to a specific directory. On windows systems
-using cmdproxy.exe as the shell, we need to use /d or the drive is never
-changed.")
+  "Command to use to change to a specific directory.
+On Windows systems using `cmdproxy.exe' as the shell,
+we need to use `/d' or the drive is never changed.")
 
 (defvar ada-command-separator (if is-windows " && " "\n")
 
 (defvar ada-command-separator (if is-windows " && " "\n")
-  "Separator to use when sending multiple commands to `compile' or
-`start-process'.
-cmdproxy.exe doesn't recognize multiple-line commands, so we have to use
+  "Separator to use between multiple commands to `compile' or `start-process'.
+`cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use
 \"&&\" for now.")
 
 (defconst ada-xref-pos-ring-max 16
 \"&&\" for now.")
 
 (defconst ada-xref-pos-ring-max 16
@@ -181,13 +213,44 @@ It has the following format:
 \((project_name . value) (project_name . value) ...)
 As always, the values of the project file are defined through properties.")
 
 \((project_name . value) (project_name . value) ...)
 As always, the values of the project file are defined through properties.")
 
+
+;; ----- Identlist manipulation -------------------------------------------
+;; An identlist is a vector that is used internally to reference an identifier
+;; To facilitate its use, we provide the following macros
+
+(defmacro ada-make-identlist () (make-vector 8 nil))
+(defmacro ada-name-of   (identlist)    (list 'aref identlist 0))
+(defmacro ada-line-of   (identlist)    (list 'aref identlist 1))
+(defmacro ada-column-of (identlist)    (list 'aref identlist 2))
+(defmacro ada-file-of   (identlist)    (list 'aref identlist 3))
+(defmacro ada-ali-index-of    (identlist) (list 'aref identlist 4))
+(defmacro ada-declare-file-of (identlist) (list 'aref identlist 5))
+(defmacro ada-references-of   (identlist) (list 'aref identlist 6))
+(defmacro ada-on-declaration  (identlist) (list 'aref identlist 7))
+
+(defmacro ada-set-name         (identlist name) (list 'aset identlist 0 name))
+(defmacro ada-set-line         (identlist line) (list 'aset identlist 1 line))
+(defmacro ada-set-column       (identlist col)  (list 'aset identlist 2 col))
+(defmacro ada-set-file         (identlist file) (list 'aset identlist 3 file))
+(defmacro ada-set-ali-index   (identlist index) (list 'aset identlist 4 index))
+(defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file))
+(defmacro ada-set-references   (identlist ref)  (list 'aset identlist 6 ref))
+(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value))
+
+(defsubst ada-get-ali-buffer (file)
+  "Reads the ali file into a new buffer, and returns this buffer's name"
+  (find-file-noselect (ada-get-ali-file-name file)))
+
+
+;; -----------------------------------------------------------------------
+
 (defun ada-quote-cmd (cmd)
 (defun ada-quote-cmd (cmd)
-  "Duplicates all \\ characters in CMD so that it can be passed to `compile'"
+  "Duplicate all \\ characters in CMD so that it can be passed to `compile'."
   (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
 
 (defun ada-initialize-runtime-library (cross-prefix)
   (mapconcat 'identity (split-string cmd "\\\\") "\\\\"))
 
 (defun ada-initialize-runtime-library (cross-prefix)
-  "Initializes the variables for the runtime library location.
-CROSS-PREFIX is the prefix to use for the gnatls command"
+  "Initialize the variables for the runtime library location.
+CROSS-PREFIX is the prefix to use for the gnatls command."
   (save-excursion
     (setq ada-xref-runtime-library-specs-path '()
          ada-xref-runtime-library-ali-path   '())
   (save-excursion
     (setq ada-xref-runtime-library-specs-path '()
          ada-xref-runtime-library-ali-path   '())
@@ -199,17 +262,18 @@ CROSS-PREFIX is the prefix to use for the gnatls command"
        ;;  Even if we get an error, delete the *gnatls* buffer
        (unwind-protect
            (progn
        ;;  Even if we get an error, delete the *gnatls* buffer
        (unwind-protect
            (progn
-             (call-process (concat cross-prefix "gnatls")
-                           nil t nil "-v")
+             (apply 'call-process (concat cross-prefix "gnatls")
+                    (append '(nil t nil) ada-gnatls-args))
              (goto-char (point-min))
 
              ;;  Source path
              (goto-char (point-min))
 
              ;;  Source path
-             
+
              (search-forward "Source Search Path:")
              (forward-line 1)
              (while (not (looking-at "^$"))
                (back-to-indentation)
              (search-forward "Source Search Path:")
              (forward-line 1)
              (while (not (looking-at "^$"))
                (back-to-indentation)
-               (unless (looking-at "<Current_Directory>")
+               (if (looking-at "<Current_Directory>")
+                   (add-to-list 'ada-xref-runtime-library-specs-path  ".")
                  (add-to-list 'ada-xref-runtime-library-specs-path
                               (buffer-substring-no-properties
                                (point)
                  (add-to-list 'ada-xref-runtime-library-specs-path
                               (buffer-substring-no-properties
                                (point)
@@ -217,12 +281,13 @@ CROSS-PREFIX is the prefix to use for the gnatls command"
                (forward-line 1))
 
              ;;  Object path
                (forward-line 1))
 
              ;;  Object path
-             
+
              (search-forward "Object Search Path:")
              (forward-line 1)
              (while (not (looking-at "^$"))
                (back-to-indentation)
              (search-forward "Object Search Path:")
              (forward-line 1)
              (while (not (looking-at "^$"))
                (back-to-indentation)
-               (unless (looking-at "<Current_Directory>")
+               (if (looking-at "<Current_Directory>")
+                   (add-to-list 'ada-xref-runtime-library-ali-path ".")
                  (add-to-list 'ada-xref-runtime-library-ali-path
                               (buffer-substring-no-properties
                                (point)
                  (add-to-list 'ada-xref-runtime-library-ali-path
                               (buffer-substring-no-properties
                                (point)
@@ -261,7 +326,7 @@ replaced by the name including the extension."
       (if (null value)
          (if (not (setq value (getenv name)))
              (message (concat "No environment variable " name " found"))))
       (if (null value)
          (if (not (setq value (getenv name)))
              (message (concat "No environment variable " name " found"))))
-               
+
       (cond
        ((null value)
        (setq cmd-string (replace-match "" t t cmd-string)))
       (cond
        ((null value)
        (setq cmd-string (replace-match "" t t cmd-string)))
@@ -282,17 +347,16 @@ replaced by the name including the extension."
        plist)
     (save-excursion
       (set-buffer ada-buffer)
        plist)
     (save-excursion
       (set-buffer ada-buffer)
-      
+
       (set 'plist
           ;;  Try hard to find a default value for filename, so that the user
           ;;  can edit his project file even if the current buffer is not an
           ;;  Ada file or not even associated with a file
           (list 'filename (expand-file-name
                            (cond
       (set 'plist
           ;;  Try hard to find a default value for filename, so that the user
           ;;  can edit his project file even if the current buffer is not an
           ;;  Ada file or not even associated with a file
           (list 'filename (expand-file-name
                            (cond
-                            (file
-                             (ada-prj-get-prj-dir file))
                             (ada-prj-default-project-file
                              ada-prj-default-project-file)
                             (ada-prj-default-project-file
                              ada-prj-default-project-file)
+                            (file (ada-prj-find-prj-file file t))
                             (t
                              (message (concat "Not editing an Ada file,"
                                               "and no default project "
                             (t
                              (message (concat "Not editing an Ada file,"
                                               "and no default project "
@@ -336,7 +400,7 @@ replaced by the name including the extension."
                 'debug_post_cmd  (list nil)))
       )
     (set symbol plist)))
                 'debug_post_cmd  (list nil)))
       )
     (set symbol plist)))
-  
+
 (defun ada-xref-get-project-field (field)
   "Extract the value of FIELD from the current project file.
 The project file must have been loaded first.
 (defun ada-xref-get-project-field (field)
   "Extract the value of FIELD from the current project file.
 The project file must have been loaded first.
@@ -352,7 +416,7 @@ addition return the default paths."
     ;;  Get the project file (either the current one, or a default one)
     (setq file (or (assoc file-name ada-xref-project-files)
                   (assoc nil ada-xref-project-files)))
     ;;  Get the project file (either the current one, or a default one)
     (setq file (or (assoc file-name ada-xref-project-files)
                   (assoc nil ada-xref-project-files)))
-       
+
     ;;  If the file was not found, use the default values
     (if file
        ;;  Get the value from the file
     ;;  If the file was not found, use the default values
     (if file
        ;;  Get the value from the file
@@ -388,10 +452,10 @@ All the directories are returned as absolute directories."
     (append
      ;; Add ${build_dir} in front of the path
      (list build-dir)
     (append
      ;; Add ${build_dir} in front of the path
      (list build-dir)
-     
+
      (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir)
                                build-dir)
      (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir)
                                build-dir)
-     
+
      ;; Add the standard runtime at the end
      ada-xref-runtime-library-specs-path)))
 
      ;; Add the standard runtime at the end
      ada-xref-runtime-library-specs-path)))
 
@@ -403,57 +467,51 @@ All the directories are returned as absolute directories."
     (append
      ;; Add ${build_dir} in front of the path
      (list build-dir)
     (append
      ;; Add ${build_dir} in front of the path
      (list build-dir)
-     
+
      (ada-get-absolute-dir-list (ada-xref-get-project-field 'obj_dir)
                                build-dir)
      (ada-get-absolute-dir-list (ada-xref-get-project-field 'obj_dir)
                                build-dir)
-     
+
      ;; Add the standard runtime at the end
      ada-xref-runtime-library-ali-path)))
 
 (defun ada-xref-update-project-menu ()
   "Update the menu Ada->Project, with the list of available project files."
      ;; Add the standard runtime at the end
      ada-xref-runtime-library-ali-path)))
 
 (defun ada-xref-update-project-menu ()
   "Update the menu Ada->Project, with the list of available project files."
-  (interactive)
-  (let (submenu)
-
-    ;;  Create the standard items
-    (set 'submenu (list (cons 'Load (cons "Load..."
-                                         'ada-set-default-project-file))
-                       (cons 'New  (cons "New..."  'ada-prj-new))
-                       (cons 'Edit (cons "Edit..." 'ada-prj-edit))
-                       (cons 'sep  (cons "---" nil))))
-    
-    ;;  Add the new items
-    (mapcar
-     (lambda (x)
-       (let ((name (or (car x) "<default>"))
-            (command `(lambda ()
-                        "Change the active project file."
-                        (interactive)
-                        (ada-parse-prj-file ,(car x))
-                        (set 'ada-prj-default-project-file ,(car x))
-                        (ada-xref-update-project-menu))))
-        (set 'submenu
-             (append submenu
-                     (list (cons (intern name)
-                                 (list
-                                  'menu-item (file-name-sans-extension
-                                              (file-name-nondirectory name))
-                                  command
-                                  :button (cons
-                                           :toggle
-                                           (equal ada-prj-default-project-file
-                                                  (car x))
-                                           ))))))))
-     
-     ;; Parses all the known project files, and insert at least the default
-     ;; one (in case ada-xref-project-files is nil)
-     (or ada-xref-project-files '(nil)))
-
-     (if (not ada-xemacs)
-         (if (lookup-key ada-mode-map [menu-bar Ada Project])
-             (setcdr (lookup-key ada-mode-map [menu-bar Ada Project])
-                    submenu)))
-    ))
+  ;; Create the standard items.
+  (let ((submenu
+        `("Project"
+          ["Load..." ada-set-default-project-file t]
+          ["New..."  ada-prj-new t]
+          ["Edit..." ada-prj-edit t]
+          "---"
+          ;;  Add the new items
+          ,@(mapcar
+             (lambda (x)
+               (let ((name (or (car x) "<default>"))
+                     (command `(lambda ()
+                                 "Change the active project file."
+                                 (interactive)
+                                 (ada-parse-prj-file ,(car x))
+                                 (set 'ada-prj-default-project-file ,(car x))
+                                 (ada-xref-update-project-menu))))
+                 (vector
+                  (if (string= (file-name-extension name)
+                               ada-project-file-extension)
+                      (file-name-sans-extension
+                       (file-name-nondirectory name))
+                    (file-name-nondirectory name))
+                  command
+                  :button (cons
+                           :toggle
+                           (equal ada-prj-default-project-file
+                                  (car x))
+                           ))))
+
+             ;; Parses all the known project files, and insert at
+             ;; least the default one (in case
+             ;; ada-xref-project-files is nil)
+             (or ada-xref-project-files '(nil))))))
+
+    (easy-menu-add-item ada-mode-menu '() submenu)))
 
 
 ;;-------------------------------------------------------------
 
 
 ;;-------------------------------------------------------------
@@ -499,207 +557,6 @@ Completion is available."
       (error (concat filename " not found in src_dir")))))
 
 
       (error (concat filename " not found in src_dir")))))
 
 
-;; ----- Keybindings ------------------------------------------------------
-
-(defun ada-add-keymap ()
-  "Add new key bindings when using `ada-xrel.el'."
-  (interactive)
-  (if ada-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-x" 'ada-reread-prj-file)
-  (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-c\C-v" 'ada-check-current)
-  (define-key ada-mode-map "\C-c\C-f" 'ada-find-file)
-  )
-
-;; ----- Menus --------------------------------------------------------------
-(defun ada-add-ada-menu ()
-  "Add some items to the standard Ada mode menu.
-The items are added to the menu called NAME, which should be the same
-name as was passed to `ada-create-menu'."
-  (interactive)
-  (if ada-xemacs
-      (let* ((menu-list '("Ada"))
-            (goto-menu '("Ada" "Goto"))
-            (edit-menu '("Ada" "Edit"))
-            (help-menu '("Ada" "Help"))
-            (options-menu (list "Ada" "Options")))
-       (funcall (symbol-function 'add-menu-button)
-                menu-list ["Check file" ada-check-current
-                           (string= mode-name "Ada")] "Goto")
-       (funcall (symbol-function 'add-menu-button)
-                menu-list ["Compile file" ada-compile-current
-                           (string= mode-name "Ada")] "Goto")
-       (funcall (symbol-function 'add-menu-button)
-                menu-list ["Build" ada-compile-application t] "Goto")
-       (funcall (symbol-function 'add-menu-button)
-                menu-list ["Run" ada-run-application t] "Goto")
-       (funcall (symbol-function 'add-menu-button)
-                menu-list ["Debug" ada-gdb-application t] "Goto")
-       (funcall (symbol-function 'add-menu-button)
-                menu-list ["--" nil t] "Goto")
-       (funcall (symbol-function 'add-menu-button)
-                goto-menu ["Goto Parent Unit" ada-goto-parent t]
-                "Next compilation error")
-       (funcall (symbol-function 'add-menu-button)
-                goto-menu ["Goto References to any entity"
-                           ada-find-any-references t]
-                "Next compilation error")
-       (funcall (symbol-function 'add-menu-button)
-                goto-menu ["List References" ada-find-references t]
-                "Next compilation error")
-       (funcall (symbol-function 'add-menu-button)
-                goto-menu ["Goto Declaration Other Frame"
-                           ada-goto-declaration-other-frame t]
-                "Next compilation error")
-       (funcall (symbol-function 'add-menu-button)
-                goto-menu ["Goto Declaration/Body"
-                           ada-goto-declaration t]
-                "Next compilation error")
-       (funcall (symbol-function 'add-menu-button)
-                goto-menu ["Goto Previous Reference"
-                           ada-xref-goto-previous-reference t]
-                "Next compilation error")
-       (funcall (symbol-function 'add-menu-button)
-                goto-menu ["--" nil t] "Next compilation error")
-       (funcall (symbol-function 'add-menu-button)
-                edit-menu ["Complete Identifier"
-                           ada-complete-identifier t]
-                "Indent Line")
-       (funcall (symbol-function 'add-menu-button)
-                edit-menu ["--------" nil t] "Indent Line")
-       (funcall (symbol-function 'add-menu-button)
-                help-menu ["Gnat User Guide" (info "gnat_ug")])
-       (funcall (symbol-function 'add-menu-button)
-                help-menu ["Gnat Reference Manual" (info "gnat_rm")])
-       (funcall (symbol-function 'add-menu-button)
-                help-menu ["Gcc Documentation" (info "gcc")])
-       (funcall (symbol-function 'add-menu-button)
-                help-menu ["Gdb Documentation" (info "gdb")])
-       (funcall (symbol-function 'add-menu-button)
-                help-menu ["Ada95 Reference Manual" (info "arm95")])
-       (funcall (symbol-function 'add-menu-button)
-                options-menu
-                ["Show Cross-References in Other Buffer"
-                 (setq ada-xref-other-buffer
-                       (not ada-xref-other-buffer))
-                 :style toggle :selected ada-xref-other-buffer])
-       (funcall (symbol-function 'add-menu-button)
-                options-menu
-                ["Automatically Recompile for Cross-References"
-                 (setq ada-xref-create-ali (not ada-xref-create-ali))
-                 :style toggle :selected ada-xref-create-ali])
-       (funcall (symbol-function 'add-menu-button)
-                options-menu
-                ["Confirm Commands"
-                 (setq ada-xref-confirm-compile
-                       (not ada-xref-confirm-compile))
-                 :style toggle :selected ada-xref-confirm-compile])
-       (if (string-match "gvd" ada-prj-default-debugger)
-           (funcall (symbol-function 'add-menu-button)
-                    options-menu
-                    ["Tight Integration With Gnu Visual Debugger"
-                     (setq ada-tight-gvd-integration
-                           (not ada-tight-gvd-integration))
-                     :style toggle :selected ada-tight-gvd-integration]))
-       )
-    
-    ;; for Emacs
-    (let* ((menu         (lookup-key ada-mode-map [menu-bar Ada]))
-          (edit-menu    (lookup-key ada-mode-map [menu-bar Ada Edit]))
-          (help-menu    (lookup-key ada-mode-map [menu-bar Ada Help]))
-          (goto-menu    (lookup-key ada-mode-map [menu-bar Ada Goto]))
-          (options-menu (lookup-key ada-mode-map [menu-bar Ada Options])))
-
-      (define-key-after menu [Check] '("Check file" . ada-check-current)
-       'Customize)
-      (define-key-after menu [Compile] '("Compile file" . ada-compile-current)
-        'Check)
-      (define-key-after menu [Build]   '("Build" . ada-compile-application)
-       'Compile)
-      (define-key-after menu [Run]     '("Run"   . ada-run-application) 'Build)
-      (define-key-after menu [Debug]   '("Debug" . ada-gdb-application) 'Run)
-      (define-key-after menu [rem]     '("--"    . nil) 'Debug)
-      (define-key-after menu [Project]
-       (cons "Project" (make-sparse-keymap)) 'rem)
-
-      (define-key help-menu [Gnat_ug]
-        '("Gnat User Guide" . (lambda() (interactive) (info "gnat_ug"))))
-      (define-key help-menu [Gnat_rm]
-        '("Gnat Reference Manual" . (lambda() (interactive) (info "gnat_rm"))))
-      (define-key help-menu [Gcc]
-        '("Gcc Documentation" . (lambda() (interactive) (info "gcc"))))
-      (define-key help-menu [gdb]
-        '("Gdb Documentation" . (lambda() (interactive) (info "gdb"))))
-      (define-key help-menu [arm95]
-        '("Ada95 Reference Manual" . (lambda() (interactive) (info "arm95"))))
-
-      (define-key goto-menu [rem]    '("----" . nil))
-      (define-key goto-menu [Parent] '("Goto Parent Unit"
-                                      . ada-goto-parent))
-      (define-key goto-menu [References-any]
-       '("Goto References to any entity" . ada-find-any-references))
-      (define-key goto-menu [References]
-       '("List References" . ada-find-references))
-      (define-key goto-menu [Prev]
-       '("Goto Previous Reference" . ada-xref-goto-previous-reference))
-      (define-key goto-menu [Decl-other]
-       '("Goto Declaration Other Frame" . ada-goto-declaration-other-frame))
-      (define-key goto-menu [Decl]
-       '("Goto Declaration/Body" . ada-goto-declaration))
-      
-      (define-key edit-menu [rem] '("----" . nil))
-      (define-key edit-menu [Complete] '("Complete Identifier"
-                                        . ada-complete-identifier))
-
-      (define-key-after options-menu [xrefrecompile]
-       '(menu-item "Automatically Recompile for Cross-References"
-                   (lambda()(interactive)
-                     (setq ada-xref-create-ali (not ada-xref-create-ali)))
-                   :button (:toggle . ada-xref-create-ali)) t)
-      (define-key-after options-menu [xrefconfirm]
-       '(menu-item "Confirm Commands"
-                  (lambda()(interactive)
-                    (setq ada-xref-confirm-compile
-                          (not ada-xref-confirm-compile)))
-                  :button (:toggle . ada-xref-confirm-compile)) t)
-      (define-key-after options-menu [xrefother]
-       '(menu-item "Show Cross-References in Other Buffer"
-                  (lambda()(interactive)
-                    (setq ada-xref-other-buffer (not ada-xref-other-buffer)))
-                  :button (:toggle . ada-xref-other-buffer)) t)
-
-      (if (string-match "gvd" ada-prj-default-debugger)
-         (define-key-after options-menu [tightgvd]
-           '(menu-item "Tight Integration With Gnu Visual Debugger"
-                       (lambda()(interactive)
-                         (setq ada-tight-gvd-integration
-                               (not ada-tight-gvd-integration)))
-                       :button (:toggle . ada-tight-gvd-integration)) t))
-
-      (define-key ada-mode-map [menu-bar Ada Edit rem3] '("------------" . nil))
-      (define-key ada-mode-map [menu-bar Ada Edit open-file-from-src-path]
-       '("Search File on source path..." . ada-find-file))
-      )
-    )
-  (ada-xref-update-project-menu)
-  )
-
 ;; ----- Utilities -------------------------------------------------
 
 (defun ada-require-project-file ()
 ;; ----- Utilities -------------------------------------------------
 
 (defun ada-require-project-file ()
@@ -708,7 +565,7 @@ name as was passed to `ada-create-menu'."
          (not ada-xref-project-files)
          (string= ada-prj-default-project-file ""))
       (ada-reread-prj-file)))
          (not ada-xref-project-files)
          (string= ada-prj-default-project-file ""))
       (ada-reread-prj-file)))
-      
+
 (defun ada-xref-push-pos (filename position)
   "Push (FILENAME, POSITION) on the position ring for cross-references."
   (setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring))
 (defun ada-xref-push-pos (filename position)
   "Push (FILENAME, POSITION) on the position ring for cross-references."
   (setq ada-xref-pos-ring (cons (list position filename) ada-xref-pos-ring))
@@ -729,42 +586,50 @@ name as was passed to `ada-create-menu'."
 This is overriden on VMS to convert from VMS filenames to Unix filenames."
   name)
 
 This is overriden on VMS to convert from VMS filenames to Unix filenames."
   name)
 
-(defun ada-set-default-project-file (name)
-  "Set the file whose name is NAME as the default project file."
+(defun ada-set-default-project-file (name &optional keep-existing)
+  "Set the file whose name is NAME as the default project file.
+If KEEP-EXISTING is true and a project file has already been loaded, nothing
+is done.  This is meant to be used from `ada-mode-hook', for instance, to force
+a project file unless the user has already loaded one."
   (interactive "fProject file:")
   (interactive "fProject file:")
-  (set 'ada-prj-default-project-file name)
-  (ada-reread-prj-file name)
-  )
+  (if (or (not keep-existing)
+         (not ada-prj-default-project-file)
+         (equal ada-prj-default-project-file ""))
+      (progn
+       (setq ada-prj-default-project-file name)
+       (ada-reread-prj-file name))))
 
 ;; ------ Handling the project file -----------------------------
 
 
 ;; ------ Handling the project file -----------------------------
 
-(defun ada-prj-find-prj-file (&optional no-user-question)
-  "Find the prj file associated with the current buffer.
+(defun ada-prj-find-prj-file (&optional file no-user-question)
+  "Find the prj file associated with FILE (or the current buffer if nil).
 If NO-USER-QUESTION is non-nil, use a default file if not project file was
 found, and do not ask the user.
 If the buffer is not an Ada buffer, associate it with the default project
 If NO-USER-QUESTION is non-nil, use a default file if not project file was
 found, and do not ask the user.
 If the buffer is not an Ada buffer, associate it with the default project
-file. If none is set, return nil."
+file.  If none is set, return nil."
 
   (let (selected)
 
     ;;  Use the active project file if there is one.
     ;;  This is also valid if we don't currently have an Ada buffer, or if
     ;;  the current buffer is not a real file (for instance an emerge buffer)
 
   (let (selected)
 
     ;;  Use the active project file if there is one.
     ;;  This is also valid if we don't currently have an Ada buffer, or if
     ;;  the current buffer is not a real file (for instance an emerge buffer)
-    
+
     (if (or (not (string= mode-name "Ada"))
     (if (or (not (string= mode-name "Ada"))
-           (not (buffer-file-name))
-           (and ada-prj-default-project-file
-                (not (string= ada-prj-default-project-file ""))))
-       (set 'selected ada-prj-default-project-file)
-      
+           (not (buffer-file-name)))
+
+       (if (and ada-prj-default-project-file
+                (not (string= ada-prj-default-project-file "")))
+           (setq selected ada-prj-default-project-file)
+         (setq selected nil))
+
       ;;  other cases: use a more complex algorithm
       ;;  other cases: use a more complex algorithm
-      
-      (let* ((current-file (buffer-file-name))
+
+      (let* ((current-file (or file (buffer-file-name)))
             (first-choice (concat
                            (file-name-sans-extension current-file)
                            ada-project-file-extension))
             (dir          (file-name-directory current-file))
             (first-choice (concat
                            (file-name-sans-extension current-file)
                            ada-project-file-extension))
             (dir          (file-name-directory current-file))
-            
+
             ;; on Emacs 20.2, directory-files does not work if
             ;; parse-sexp-lookup-properties is set
             (parse-sexp-lookup-properties nil)
             ;; on Emacs 20.2, directory-files does not work if
             ;; parse-sexp-lookup-properties is set
             (parse-sexp-lookup-properties nil)
@@ -773,18 +638,18 @@ file. If none is set, return nil."
                            (concat ".*" (regexp-quote
                                          ada-project-file-extension) "$")))
             (choice       nil))
                            (concat ".*" (regexp-quote
                                          ada-project-file-extension) "$")))
             (choice       nil))
-       
+
        (cond
        (cond
-        
+
         ;;  Else if there is a project file with the same name as the Ada
         ;;  file, but not the same extension.
         ((file-exists-p first-choice)
          (set 'selected first-choice))
         ;;  Else if there is a project file with the same name as the Ada
         ;;  file, but not the same extension.
         ((file-exists-p first-choice)
          (set 'selected first-choice))
-        
+
         ;;  Else if only one project file was found in the current directory
         ((= (length prj-files) 1)
          (set 'selected (car prj-files)))
         ;;  Else if only one project file was found in the current directory
         ((= (length prj-files) 1)
          (set 'selected (car prj-files)))
-        
+
         ;;  Else if there are multiple files, ask the user
         ((and (> (length prj-files) 1) (not no-user-question))
          (save-window-excursion
         ;;  Else if there are multiple files, ask the user
         ((and (> (length prj-files) 1) (not no-user-question))
          (save-window-excursion
@@ -799,6 +664,7 @@ file. If none is set, return nil."
                                 counter
                                 (nth (1- counter) prj-files)))
                  (setq counter (1+ counter))
                                 counter
                                 (nth (1- counter) prj-files)))
                  (setq counter (1+ counter))
+
                  ))) ; end of with-output-to ...
            (setq choice nil)
            (while (or
                  ))) ; end of with-output-to ...
            (setq choice nil)
            (while (or
@@ -809,7 +675,7 @@ file. If none is set, return nil."
              (setq choice (string-to-int
                            (read-from-minibuffer "Enter No. of your choice: "))))
            (set 'selected (nth (1- choice) prj-files))))
              (setq choice (string-to-int
                            (read-from-minibuffer "Enter No. of your choice: "))))
            (set 'selected (nth (1- choice) prj-files))))
-        
+
         ;; Else if no project file was found in the directory, ask a name
         ;; to the user, using as a default value the last one entered by
         ;; the user
         ;; Else if no project file was found in the directory, ask a name
         ;; to the user, using as a default value the last one entered by
         ;; the user
@@ -822,7 +688,8 @@ file. If none is set, return nil."
            (unless (string= ada-last-prj-file "")
              (set 'selected ada-last-prj-file))))
         )))
            (unless (string= ada-last-prj-file "")
              (set 'selected ada-last-prj-file))))
         )))
-    selected
+
+    (or selected "default.adp")
     ))
 
 
     ))
 
 
@@ -835,85 +702,117 @@ The current buffer should be the ada-file buffer."
             (ada-buffer (current-buffer)))
        (setq prj-file (expand-file-name prj-file))
 
             (ada-buffer (current-buffer)))
        (setq prj-file (expand-file-name prj-file))
 
+       ;;  Set the project file as the active one.
+       (setq ada-prj-default-project-file prj-file)
+
        ;;  Initialize the project with the default values
        (ada-xref-set-default-prj-values 'project (current-buffer))
 
        ;;  Do not use find-file below, since we don't want to show this
        ;;  Initialize the project with the default values
        (ada-xref-set-default-prj-values 'project (current-buffer))
 
        ;;  Do not use find-file below, since we don't want to show this
-       ;;  buffer. If the file is open through speedbar, we can't use
+       ;;  buffer.  If the file is open through speedbar, we can't use
        ;;  find-file anyway, since the speedbar frame is special and does not
        ;;  allow the selection of a file in it.
 
        ;;  find-file anyway, since the speedbar frame is special and does not
        ;;  allow the selection of a file in it.
 
-       (set-buffer (find-file-noselect prj-file))
-       
-       (widen)
-       (goto-char (point-min))
-
-       ;;  Now overrides these values with the project file
-       (while (not (eobp))
-         (if (looking-at "^\\([^=]+\\)=\\(.*\\)")
-             (cond
-              ((string= (match-string 1) "src_dir")
-               (add-to-list 'src_dir
-                            (file-name-as-directory (match-string 2))))
-              ((string= (match-string 1) "obj_dir")
-               (add-to-list 'obj_dir
-                            (file-name-as-directory (match-string 2))))
-              ((string= (match-string 1) "casing")
-               (set 'casing (cons (match-string 2) casing)))
-              ((string= (match-string 1) "build_dir")
-               (set 'project
-                    (plist-put project 'build_dir
-                               (file-name-as-directory (match-string 2)))))
-              ((string= (match-string 1) "make_cmd")
-               (add-to-list 'make_cmd (match-string 2)))
-              ((string= (match-string 1) "comp_cmd")
-               (add-to-list 'comp_cmd (match-string 2)))
-              ((string= (match-string 1) "check_cmd")
-               (add-to-list 'check_cmd (match-string 2)))
-              ((string= (match-string 1) "run_cmd")
-               (add-to-list 'run_cmd (match-string 2)))
-              ((string= (match-string 1) "debug_pre_cmd")
-               (add-to-list 'debug_pre_cmd (match-string 2)))
-              ((string= (match-string 1) "debug_post_cmd")
-               (add-to-list 'debug_post_cmd (match-string 2)))
-              (t
-               (set 'project (plist-put project (intern (match-string 1))
-                                        (match-string 2))))))
-         (forward-line 1))
-       
-       (if src_dir (set 'project (plist-put project 'src_dir
-                                            (reverse src_dir))))
-       (if obj_dir (set 'project (plist-put project 'obj_dir
-                                            (reverse obj_dir))))
-       (if casing  (set 'project (plist-put project 'casing
-                                            (reverse casing))))
-       (if make_cmd (set 'project (plist-put project 'make_cmd
-                                             (reverse make_cmd))))
-       (if comp_cmd (set 'project (plist-put project 'comp_cmd
-                                             (reverse comp_cmd))))
-       (if check_cmd (set 'project (plist-put project 'check_cmd
-                                              (reverse check_cmd))))
-       (if run_cmd (set 'project (plist-put project 'run_cmd
-                                            (reverse run_cmd))))
-       (set 'project (plist-put project 'debug_post_cmd
-                                (reverse debug_post_cmd)))
-       (set 'project (plist-put project 'debug_pre_cmd
-                                (reverse debug_pre_cmd)))
+       (if (file-exists-p prj-file)
+           (progn
+             (let* ((buffer (run-hook-with-args-until-success
+                             'ada-load-project-hook prj-file)))
+               (unless buffer
+                 (setq buffer (find-file-noselect prj-file nil)))
+               (set-buffer buffer))
+
+             (widen)
+             (goto-char (point-min))
+
+             ;;  Now overrides these values with the project file
+             (while (not (eobp))
+               (if (looking-at "^\\([^=]+\\)=\\(.*\\)")
+                   (cond
+                    ((string= (match-string 1) "src_dir")
+                     (add-to-list 'src_dir
+                                  (file-name-as-directory (match-string 2))))
+                    ((string= (match-string 1) "obj_dir")
+                     (add-to-list 'obj_dir
+                                  (file-name-as-directory (match-string 2))))
+                    ((string= (match-string 1) "casing")
+                     (set 'casing (cons (match-string 2) casing)))
+                    ((string= (match-string 1) "build_dir")
+                     (set 'project
+                          (plist-put project 'build_dir
+                                     (file-name-as-directory (match-string 2)))))
+                    ((string= (match-string 1) "make_cmd")
+                     (add-to-list 'make_cmd (match-string 2)))
+                    ((string= (match-string 1) "comp_cmd")
+                     (add-to-list 'comp_cmd (match-string 2)))
+                    ((string= (match-string 1) "check_cmd")
+                     (add-to-list 'check_cmd (match-string 2)))
+                    ((string= (match-string 1) "run_cmd")
+                     (add-to-list 'run_cmd (match-string 2)))
+                    ((string= (match-string 1) "debug_pre_cmd")
+                     (add-to-list 'debug_pre_cmd (match-string 2)))
+                    ((string= (match-string 1) "debug_post_cmd")
+                     (add-to-list 'debug_post_cmd (match-string 2)))
+                    (t
+                     (set 'project (plist-put project (intern (match-string 1))
+                                              (match-string 2))))))
+               (forward-line 1))
+
+             (if src_dir (set 'project (plist-put project 'src_dir
+                                                  (reverse src_dir))))
+             (if obj_dir (set 'project (plist-put project 'obj_dir
+                                                  (reverse obj_dir))))
+             (if casing  (set 'project (plist-put project 'casing
+                                                  (reverse casing))))
+             (if make_cmd (set 'project (plist-put project 'make_cmd
+                                                   (reverse make_cmd))))
+             (if comp_cmd (set 'project (plist-put project 'comp_cmd
+                                                   (reverse comp_cmd))))
+             (if check_cmd (set 'project (plist-put project 'check_cmd
+                                                    (reverse check_cmd))))
+             (if run_cmd (set 'project (plist-put project 'run_cmd
+                                                  (reverse run_cmd))))
+             (set 'project (plist-put project 'debug_post_cmd
+                                      (reverse debug_post_cmd)))
+             (set 'project (plist-put project 'debug_pre_cmd
+                                      (reverse debug_pre_cmd)))
+
+             ;; Kill the project buffer
+             (kill-buffer nil)
+             (set-buffer ada-buffer)
+             )
+
+         ;;  Else the file wasn't readable (probably the default project).
+         ;;  We initialize it with the current environment variables.
+          ;;  We need to add the startup directory in front so that
+          ;;  files locally redefined are properly found.  We cannot
+          ;;  add ".", which varies too much depending on what the
+          ;;  current buffer is.
+         (set 'project
+              (plist-put project 'src_dir
+                         (append
+                           (list command-line-default-directory)
+                          (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
+                          (list "." default-directory))))
+         (set 'project
+              (plist-put project 'obj_dir
+                         (append
+                           (list command-line-default-directory)
+                          (split-string (or (getenv "ADA_OBJECTS_PATH") "") ":")
+                          (list "." default-directory))))
+         )
+
 
        ;;  Delete the default project file from the list, if it is there.
        ;;  Note that in that case, this default project is the only one in
        ;;  the list
        (if (assoc nil ada-xref-project-files)
            (setq ada-xref-project-files nil))
 
        ;;  Delete the default project file from the list, if it is there.
        ;;  Note that in that case, this default project is the only one in
        ;;  the list
        (if (assoc nil ada-xref-project-files)
            (setq ada-xref-project-files nil))
-       
+
        ;;  Memorize the newly read project file
        (if (assoc prj-file ada-xref-project-files)
            (setcdr (assoc prj-file ada-xref-project-files) project)
          (add-to-list 'ada-xref-project-files (cons prj-file project)))
 
        ;;  Memorize the newly read project file
        (if (assoc prj-file ada-xref-project-files)
            (setcdr (assoc prj-file ada-xref-project-files) project)
          (add-to-list 'ada-xref-project-files (cons prj-file project)))
 
-       ;;  Set the project file as the active one.
-       (setq ada-prj-default-project-file prj-file)
-       
        ;; Sets up the compilation-search-path so that Emacs is able to
        ;; go to the source of the errors in a compilation buffer
        (setq compilation-search-path (ada-xref-get-src-dir-field))
        ;; Sets up the compilation-search-path so that Emacs is able to
        ;; go to the source of the errors in a compilation buffer
        (setq compilation-search-path (ada-xref-get-src-dir-field))
@@ -923,35 +822,31 @@ The current buffer should be the ada-file buffer."
             (progn
               (setq ada-case-exception-file (reverse casing))
               (ada-case-read-exceptions)))
             (progn
               (setq ada-case-exception-file (reverse casing))
               (ada-case-read-exceptions)))
-       
+
        ;; Add the directories to the search path for ff-find-other-file
        ;; Do not add the '/' or '\' at the end
        ;; Add the directories to the search path for ff-find-other-file
        ;; Do not add the '/' or '\' at the end
-       (setq ada-search-directories
+       (setq ada-search-directories-internal
             (append (mapcar 'directory-file-name compilation-search-path)
                     ada-search-directories))
             (append (mapcar 'directory-file-name compilation-search-path)
                     ada-search-directories))
-       
-       ;; Kill the .ali buffer
-       (kill-buffer nil)
-       (set-buffer ada-buffer)
 
        (ada-xref-update-project-menu)
        )
 
     ;;  No prj file ? => Setup default values
     ;;  Note that nil means that all compilation modes will first look in the
 
        (ada-xref-update-project-menu)
        )
 
     ;;  No prj file ? => Setup default values
     ;;  Note that nil means that all compilation modes will first look in the
-    ;;  current directory, and only then in the current file's directory. This
+    ;;  current directory, and only then in the current file's directory.  This
     ;;  current file is assumed at this point to be in the common source
     ;;  directory.
     (setq compilation-search-path (list nil default-directory))
     ))
     ;;  current file is assumed at this point to be in the common source
     ;;  directory.
     (setq compilation-search-path (list nil default-directory))
     ))
-      
-    
-(defun ada-find-references (&optional pos)
+
+
+(defun ada-find-references (&optional pos arg local-only)
   "Find all references to the entity under POS.
   "Find all references to the entity under POS.
-Calls gnatfind to find the references."
-  (interactive "")
-  (unless pos
-    (set 'pos (point)))
+Calls gnatfind to find the references.
+If ARG is t, the contents of the old *gnatfind* buffer is preserved.
+If LOCAL-ONLY is t, only the declarations in the current file are returned."
+  (interactive "d\nP")
   (ada-require-project-file)
 
   (let* ((identlist (ada-read-identifier pos))
   (ada-require-project-file)
 
   (let* ((identlist (ada-read-identifier pos))
@@ -965,20 +860,32 @@ Calls gnatfind to find the references."
             (file-newer-than-file-p (ada-file-of identlist) alifile))
         (ada-find-any-references (ada-name-of identlist)
                                  (ada-file-of identlist)
             (file-newer-than-file-p (ada-file-of identlist) alifile))
         (ada-find-any-references (ada-name-of identlist)
                                  (ada-file-of identlist)
-                                 nil nil)
+                                 nil nil local-only arg)
       (ada-find-any-references (ada-name-of identlist)
                                (ada-file-of identlist)
                                (ada-line-of identlist)
       (ada-find-any-references (ada-name-of identlist)
                                (ada-file-of identlist)
                                (ada-line-of identlist)
-                               (ada-column-of identlist))))
+                               (ada-column-of identlist) local-only arg)))
   )
 
   )
 
-(defun ada-find-any-references (entity &optional file line column)
+(defun ada-find-local-references (&optional pos arg)
+  "Find all references to the entity under POS.
+Calls `gnatfind' to find the references.
+If ARG is t, the contents of the old *gnatfind* buffer is preserved."
+  (interactive "d\nP")
+  (ada-find-references pos arg t))
+
+(defun ada-find-any-references
+  (entity &optional file line column local-only append)
   "Search for references to any entity whose name is ENTITY.
   "Search for references to any entity whose name is ENTITY.
-ENTITY was first found the location given by FILE, LINE and COLUMN."
+ENTITY was first found the location given by FILE, LINE and COLUMN.
+If LOCAL-ONLY is t, then list only the references in FILE, which
+is much faster.
+If APPEND is t, then append the output of the command to the existing
+buffer `*gnatfind*', if there is one."
   (interactive "sEntity name: ")
   (ada-require-project-file)
 
   (interactive "sEntity name: ")
   (ada-require-project-file)
 
-  ;;  Prepare the gnatfind command. Note that we must protect the quotes
+  ;;  Prepare the gnatfind command.  Note that we must protect the quotes
   ;;  around operators, so that they are correctly handled and can be
   ;;  processed (gnatfind \"+\":...).
   (let* ((quote-entity
   ;;  around operators, so that they are correctly handled and can be
   ;;  processed (gnatfind \"+\":...).
   (let* ((quote-entity
@@ -988,62 +895,51 @@ ENTITY was first found the location given by FILE, LINE and COLUMN."
                (concat "'\"" (substring entity 1 -1) "\"'"))
            entity))
         (switches (ada-xref-get-project-field 'gnatfind_opt))
                (concat "'\"" (substring entity 1 -1) "\"'"))
            entity))
         (switches (ada-xref-get-project-field 'gnatfind_opt))
-        (command (concat "gnatfind " switches " "
+        (command (concat "gnat find " switches " "
                          quote-entity
                           (if file (concat ":" (file-name-nondirectory file)))
                           (if line (concat ":" line))
                          quote-entity
                           (if file (concat ":" (file-name-nondirectory file)))
                           (if line (concat ":" line))
-                          (if column (concat ":" column)))))
+                          (if column (concat ":" column))
+                         (if local-only (concat " " (file-name-nondirectory file)))
+                         ))
+        old-contents)
 
     ;;  If a project file is defined, use it
     (if (and ada-prj-default-project-file
             (not (string= ada-prj-default-project-file "")))
 
     ;;  If a project file is defined, use it
     (if (and ada-prj-default-project-file
             (not (string= ada-prj-default-project-file "")))
-        (setq command (concat command " -p" ada-prj-default-project-file)))
+        (if (string-equal (file-name-extension ada-prj-default-project-file)
+                          "gpr")
+            (setq command (concat command " -P" ada-prj-default-project-file))
+          (setq command (concat command " -p" ada-prj-default-project-file))))
+
+    (if (and append (get-buffer "*gnatfind*"))
+       (save-excursion
+         (set-buffer "*gnatfind*")
+         (setq old-contents (buffer-string))))
 
 
-    (compile-internal command "No more references" "gnatfind")
+    (let ((compilation-error "reference"))
+      (compilation-start command))
 
     ;;  Hide the "Compilation" menu
     (save-excursion
       (set-buffer "*gnatfind*")
 
     ;;  Hide the "Compilation" menu
     (save-excursion
       (set-buffer "*gnatfind*")
-      (local-unset-key [menu-bar compilation-menu]))
+      (local-unset-key [menu-bar compilation-menu])
+
+      (if old-contents
+         (progn
+           (goto-char 1)
+           (insert old-contents)
+           (goto-char (point-max)))))
     )
   )
 
 (defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file))
 
     )
   )
 
 (defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file))
 
-;; ----- Identlist manipulation -------------------------------------------
-;; An identlist is a vector that is used internally to reference an identifier
-;; To facilitate its use, we provide the following macros
-
-(defmacro ada-make-identlist () (make-vector 8 nil))
-(defmacro ada-name-of   (identlist)    (list 'aref identlist 0))
-(defmacro ada-line-of   (identlist)    (list 'aref identlist 1))
-(defmacro ada-column-of (identlist)    (list 'aref identlist 2))
-(defmacro ada-file-of   (identlist)    (list 'aref identlist 3))
-(defmacro ada-ali-index-of    (identlist) (list 'aref identlist 4))
-(defmacro ada-declare-file-of (identlist) (list 'aref identlist 5))
-(defmacro ada-references-of   (identlist) (list 'aref identlist 6))
-(defmacro ada-on-declaration  (identlist) (list 'aref identlist 7))
-
-(defmacro ada-set-name         (identlist name) (list 'aset identlist 0 name))
-(defmacro ada-set-line         (identlist line) (list 'aset identlist 1 line))
-(defmacro ada-set-column       (identlist col)  (list 'aset identlist 2 col))
-(defmacro ada-set-file         (identlist file) (list 'aset identlist 3 file))
-(defmacro ada-set-ali-index   (identlist index) (list 'aset identlist 4 index))
-(defmacro ada-set-declare-file (identlist file) (list 'aset identlist 5 file))
-(defmacro ada-set-references   (identlist ref)  (list 'aset identlist 6 ref))
-(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value))
-
-(defsubst ada-get-ali-buffer (file)
-  "Reads the ali file into a new buffer, and returns this buffer's name"
-  (find-file-noselect (ada-get-ali-file-name file)))
-
-
-
 ;; ----- Identifier Completion --------------------------------------------
 (defun ada-complete-identifier (pos)
   "Tries to complete the identifier around POS.
 ;; ----- Identifier Completion --------------------------------------------
 (defun ada-complete-identifier (pos)
   "Tries to complete the identifier around POS.
-The feature is only available if the files where compiled not using the -gnatx
-option."
+The feature is only available if the files where compiled without
+the option `-gnatx'."
   (interactive "d")
   (ada-require-project-file)
 
   (interactive "d")
   (ada-require-project-file)
 
@@ -1081,11 +977,29 @@ option."
 ;; ----- Cross-referencing ----------------------------------------
 
 (defun ada-point-and-xref ()
 ;; ----- Cross-referencing ----------------------------------------
 
 (defun ada-point-and-xref ()
- "Calls `mouse-set-point' and then `ada-goto-declaration'."
+  "Jump to the declaration of the entity below the cursor."
   (interactive)
   (mouse-set-point last-input-event)
   (ada-goto-declaration (point)))
 
   (interactive)
   (mouse-set-point last-input-event)
   (ada-goto-declaration (point)))
 
+(defun ada-point-and-xref-body ()
+  "Jump to the body of the entity under the cursor."
+  (interactive)
+  (mouse-set-point last-input-event)
+  (ada-goto-body (point)))
+
+(defun ada-goto-body (pos &optional other-frame)
+  "Display the body of the entity around POS.
+If the entity doesn't have a body, display its declaration.
+As a side effect, the buffer for the declaration is also open."
+  (interactive "d")
+  (ada-goto-declaration pos other-frame)
+
+  ;;  Temporarily force the display in the same buffer, since we
+  ;;  already changed previously
+  (let ((ada-xref-other-buffer nil))
+    (ada-goto-declaration (point) nil)))
+
 (defun ada-goto-declaration (pos &optional other-frame)
   "Display the declaration of the identifier around POS.
 The declaration is shown in another buffer if `ada-xref-other-buffer' is
 (defun ada-goto-declaration (pos &optional other-frame)
   "Display the declaration of the identifier around POS.
 The declaration is shown in another buffer if `ada-xref-other-buffer' is
@@ -1102,9 +1016,22 @@ If OTHER-FRAME is non-nil, display the cross-reference in another frame."
   (let ((identlist (ada-read-identifier pos)))
     (condition-case nil
        (ada-find-in-ali identlist other-frame)
   (let ((identlist (ada-read-identifier pos)))
     (condition-case nil
        (ada-find-in-ali identlist other-frame)
-      (error (ada-find-in-src-path identlist other-frame)))))
-
-(defun ada-goto-declaration-other-frame (pos &optional other-frame)
+      (error
+       (let ((ali-file (ada-get-ali-file-name (ada-file-of identlist))))
+
+        ;; If the ALI file was up-to-date, then we probably have a predefined
+        ;; entity, whose references are not given by GNAT
+        (if (and (file-exists-p ali-file)
+                 (file-newer-than-file-p ali-file (ada-file-of identlist)))
+            (message "No cross-reference found--may be a predefined entity.")
+
+          ;; Else, look in every ALI file, except if the user doesn't want that
+          (if ada-xref-search-with-egrep
+              (ada-find-in-src-path identlist other-frame)
+            (message "Cross-referencing information is not up-to-date; please recompile.")
+            )))))))
+
+(defun ada-goto-declaration-other-frame (pos)
   "Display the declaration of the identifier around POS.
 The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
   (interactive "d")
   "Display the declaration of the identifier around POS.
 The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
   (interactive "d")
@@ -1122,12 +1049,13 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
 
 (defun ada-get-absolute-dir-list (dir-list root-dir)
   "Returns the list of absolute directories found in dir-list.
 
 (defun ada-get-absolute-dir-list (dir-list root-dir)
   "Returns the list of absolute directories found in dir-list.
-If a directory is a relative directory, the value of ROOT-DIR is added in
-front."
+If a directory is a relative directory, add the value of ROOT-DIR in front."
   (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list))
 
 (defun ada-set-environment ()
   (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list))
 
 (defun ada-set-environment ()
-  "Return the new value for process-environment.
+  "Prepare an environment for Ada compilation.
+This returns a new value to use for `process-environment',
+but does not actually put it into use.
 It modifies the source path and object path with the values found in the
 project file."
   (let ((include   (getenv "ADA_INCLUDE_PATH"))
 It modifies the source path and object path with the values found in the
 project file."
   (let ((include   (getenv "ADA_INCLUDE_PATH"))
@@ -1152,7 +1080,7 @@ project file."
       process-environment))))
 
 (defun ada-compile-application (&optional arg)
       process-environment))))
 
 (defun ada-compile-application (&optional arg)
-  "Compiles the application, using the command found in the project file.
+  "Compile the application, using the command found in the project file.
 If ARG is not nil, ask for user confirmation."
   (interactive "P")
   (ada-require-project-file)
 If ARG is not nil, ask for user confirmation."
   (interactive "P")
   (ada-require-project-file)
@@ -1169,16 +1097,16 @@ If ARG is not nil, ask for user confirmation."
     ;;  Make a single command from the list of commands, including the
     ;;  commands to run it on a remote machine.
     (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator)))
     ;;  Make a single command from the list of commands, including the
     ;;  commands to run it on a remote machine.
     (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator)))
-    
+
     (if (or ada-xref-confirm-compile arg)
        (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
 
     ;;  Insert newlines so as to separate the name of the commands to run
     (if (or ada-xref-confirm-compile arg)
        (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
 
     ;;  Insert newlines so as to separate the name of the commands to run
-    ;;  and the output of the commands. this doesn't work with cmdproxy.exe,
+    ;;  and the output of the commands.  This doesn't work with cmdproxy.exe,
     ;;  which gets confused by newline characters.
     ;;  which gets confused by newline characters.
-    (if (not (string-match "cmdproxy.exe" shell-file-name))
+    (if (not (string-match ".exe" shell-file-name))
        (setq cmd (concat cmd "\n\n")))
        (setq cmd (concat cmd "\n\n")))
-    
+
     (compile (ada-quote-cmd cmd))))
 
 (defun ada-compile-current (&optional arg prj-field)
     (compile (ada-quote-cmd cmd))))
 
 (defun ada-compile-current (&optional arg prj-field)
@@ -1192,26 +1120,26 @@ command, and should be either comp_cmd (default) or check_cmd."
         (cmd (ada-xref-get-project-field field))
         (process-environment (ada-set-environment))
         (compilation-scroll-output t))
         (cmd (ada-xref-get-project-field field))
         (process-environment (ada-set-environment))
         (compilation-scroll-output t))
-    
+
     (setq compilation-search-path (ada-xref-get-src-dir-field))
 
     (unless cmd
       (setq cmd '("") arg t))
     (setq compilation-search-path (ada-xref-get-src-dir-field))
 
     (unless cmd
       (setq cmd '("") arg t))
-    
+
     ;;  Make a single command from the list of commands, including the
     ;;  commands to run it on a remote machine.
     (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator)))
     ;;  Make a single command from the list of commands, including the
     ;;  commands to run it on a remote machine.
     (setq cmd (ada-remote (mapconcat 'identity cmd ada-command-separator)))
-    
+
     ;;  If no project file was found, ask the user
     (if (or ada-xref-confirm-compile arg)
        (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
 
     ;;  Insert newlines so as to separate the name of the commands to run
     ;;  If no project file was found, ask the user
     (if (or ada-xref-confirm-compile arg)
        (setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
 
     ;;  Insert newlines so as to separate the name of the commands to run
-    ;;  and the output of the commands. this doesn't work with cmdproxy.exe,
+    ;;  and the output of the commands.  This doesn't work with cmdproxy.exe,
     ;;  which gets confused by newline characters.
     ;;  which gets confused by newline characters.
-    (if (not (string-match "cmdproxy.exe" shell-file-name))
+    (if (not (string-match ".exe" shell-file-name))
        (setq cmd (concat cmd "\n\n")))
        (setq cmd (concat cmd "\n\n")))
-    
+
     (compile (ada-quote-cmd cmd))))
 
 (defun ada-check-current (&optional arg)
     (compile (ada-quote-cmd cmd))))
 
 (defun ada-check-current (&optional arg)
@@ -1222,7 +1150,7 @@ If ARG is not nil, ask for user confirmation of the command."
 
 (defun ada-run-application (&optional arg)
   "Run the application.
 
 (defun ada-run-application (&optional arg)
   "Run the application.
-if ARG is not-nil, asks for user confirmation."
+if ARG is not-nil, ask for user confirmation."
   (interactive)
   (ada-require-project-file)
 
   (interactive)
   (ada-require-project-file)
 
@@ -1239,7 +1167,7 @@ if ARG is not-nil, asks for user confirmation."
     ;; Modify the command to run remotely
     (setq command (ada-remote (mapconcat 'identity command
                                         ada-command-separator)))
     ;; Modify the command to run remotely
     (setq command (ada-remote (mapconcat 'identity command
                                         ada-command-separator)))
-    
+
     ;; Ask for the arguments to the command if required
     (if (or ada-xref-confirm-compile arg)
        (setq command (read-from-minibuffer "Enter command to execute: "
     ;; Ask for the arguments to the command if required
     (if (or ada-xref-confirm-compile arg)
        (setq command (read-from-minibuffer "Enter command to execute: "
@@ -1297,7 +1225,7 @@ If ARG is non-nil, ask the user to confirm the command."
        ;;  We make sure that gvd swallows the new frame, not the one the
        ;;  user has been using until now
        ;;  The frame is made invisible initially, so that GtkPlug gets a
        ;;  We make sure that gvd swallows the new frame, not the one the
        ;;  user has been using until now
        ;;  The frame is made invisible initially, so that GtkPlug gets a
-       ;;  chance to fully manage it. Then it works fine with Enlightenment
+       ;;  chance to fully manage it.  Then it works fine with Enlightenment
        ;;  as well
        (let ((frame (make-frame '((visibility . nil)))))
          (set 'cmd (concat
        ;;  as well
        (let ((frame (make-frame '((visibility . nil)))))
          (set 'cmd (concat
@@ -1313,11 +1241,10 @@ If ARG is non-nil, ask the user to confirm the command."
     (if (or arg ada-xref-confirm-compile)
        (set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))
 
     (if (or arg ada-xref-confirm-compile)
        (set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))
 
-    (let (comint-exec
-         in-post-mode
-         gud-gdb-massage-args)
+    (let ((old-comint-exec (symbol-function 'comint-exec)))
 
       ;;  Do not add -fullname, since we can have a 'rsh' command in front.
 
       ;;  Do not add -fullname, since we can have a 'rsh' command in front.
+      ;;  FIXME: This is evil but luckily a nop under Emacs-21.3.50 !  -stef
       (fset 'gud-gdb-massage-args (lambda (file args) args))
 
       (set 'pre-cmd  (mapconcat 'identity pre-cmd  ada-command-separator))
       (fset 'gud-gdb-massage-args (lambda (file args) args))
 
       (set 'pre-cmd  (mapconcat 'identity pre-cmd  ada-command-separator))
@@ -1326,11 +1253,13 @@ If ARG is non-nil, ask the user to confirm the command."
 
       (set 'post-cmd (mapconcat 'identity post-cmd "\n"))
       (if post-cmd
 
       (set 'post-cmd (mapconcat 'identity post-cmd "\n"))
       (if post-cmd
-       (set 'post-cmd (concat post-cmd "\n")))
+         (set 'post-cmd (concat post-cmd "\n")))
+
 
       ;;  Temporarily replaces the definition of `comint-exec' so that we
       ;;  can execute commands before running gdb.
 
       ;;  Temporarily replaces the definition of `comint-exec' so that we
       ;;  can execute commands before running gdb.
-      (fset 'comint-exec 
+      ;;  FIXME: This is evil and not temporary !!!  -stef
+      (fset 'comint-exec
            `(lambda (buffer name command startfile switches)
               (let (compilation-buffer-name-function)
                 (save-excursion
            `(lambda (buffer name command startfile switches)
               (let (compilation-buffer-name-function)
                 (save-excursion
@@ -1347,12 +1276,17 @@ If ARG is non-nil, ask the user to confirm the command."
               ada-tight-gvd-integration
               (not (string-match "--tty" cmd)))
          (setq cmd (concat cmd "--tty")))
               ada-tight-gvd-integration
               (not (string-match "--tty" cmd)))
          (setq cmd (concat cmd "--tty")))
-      
+
       (if (and (string-match "jdb" (comint-arguments cmd 0 0))
               (boundp 'jdb))
          (funcall (symbol-function 'jdb) cmd)
        (gdb cmd))
 
       (if (and (string-match "jdb" (comint-arguments cmd 0 0))
               (boundp 'jdb))
          (funcall (symbol-function 'jdb) cmd)
        (gdb cmd))
 
+      ;;  Restore the standard fset command (or for instance C-U M-x shell
+      ;;  wouldn't work anymore
+
+      (fset 'comint-exec old-comint-exec)
+
       ;;  Send post-commands to the debugger
       (process-send-string (get-buffer-process (current-buffer)) post-cmd)
 
       ;;  Send post-commands to the debugger
       (process-send-string (get-buffer-process (current-buffer)) post-cmd)
 
@@ -1361,7 +1295,7 @@ If ARG is non-nil, ask the user to confirm the command."
       (end-of-buffer)
 
       ;;  Display both the source window and the debugger window (the former
       (end-of-buffer)
 
       ;;  Display both the source window and the debugger window (the former
-      ;;  above the latter). No need to show the debugger window unless it
+      ;;  above the latter).  No need to show the debugger window unless it
       ;;  is going to have some relevant information.
       (if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
              (string-match "--tty" cmd))
       ;;  is going to have some relevant information.
       (if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
              (string-match "--tty" cmd))
@@ -1383,7 +1317,7 @@ automatically modifies the setup for all the Ada buffer that use this file."
 
   ;; Reread the location of the standard runtime library
   (ada-initialize-runtime-library
 
   ;; Reread the location of the standard runtime library
   (ada-initialize-runtime-library
-   (or (ada-xref-get-project-field 'cross-prefix) ""))
+   (or (ada-xref-get-project-field 'cross_prefix) ""))
   )
 
 ;; ------ Private routines
   )
 
 ;; ------ Private routines
@@ -1392,17 +1326,17 @@ automatically modifies the setup for all the Ada buffer that use this file."
   "Update the cross-references for FILE.
 This in fact recompiles FILE to create ALI-FILE-NAME.
 This function returns the name of the file that was recompiled to generate
   "Update the cross-references for FILE.
 This in fact recompiles FILE to create ALI-FILE-NAME.
 This function returns the name of the file that was recompiled to generate
-the cross-reference information. Note that the ali file can then be deduced by
-replacing the file extension with .ali"
+the cross-reference information.  Note that the ali file can then be deduced by
+replacing the file extension with `.ali'."
   ;; kill old buffer
   (if (and ali-file-name
            (get-file-buffer ali-file-name))
       (kill-buffer (get-file-buffer ali-file-name)))
   ;; kill old buffer
   (if (and ali-file-name
            (get-file-buffer ali-file-name))
       (kill-buffer (get-file-buffer ali-file-name)))
-  
+
   (let* ((name      (ada-convert-file-name file))
         (body-name (or (ada-get-body-name name) name)))
 
   (let* ((name      (ada-convert-file-name file))
         (body-name (or (ada-get-body-name name) name)))
 
-    ;; Always recompile the body when we can. We thus temporarily switch to a
+    ;; Always recompile the body when we can.  We thus temporarily switch to a
     ;; buffer than contains the body of the unit
     (save-excursion
       (let ((body-visible (find-buffer-visiting body-name))
     ;; buffer than contains the body of the unit
     (save-excursion
       (let ((body-visible (find-buffer-visiting body-name))
@@ -1411,7 +1345,7 @@ replacing the file extension with .ali"
            (set-buffer body-visible)
          (find-file body-name))
 
            (set-buffer body-visible)
          (find-file body-name))
 
-       ;; Execute the compilation. Note that we must wait for the end of the
+       ;; Execute the compilation.  Note that we must wait for the end of the
        ;; process, or the ALI file would still not be available.
        ;; Unfortunately, the underlying `compile' command that we use is
        ;; asynchronous.
        ;; process, or the ALI file would still not be available.
        ;; Unfortunately, the underlying `compile' command that we use is
        ;; asynchronous.
@@ -1434,20 +1368,20 @@ replacing the file extension with .ali"
     (while (and (not found) dir-list)
       (set 'found (concat (file-name-as-directory (car dir-list))
                          (file-name-nondirectory file)))
     (while (and (not found) dir-list)
       (set 'found (concat (file-name-as-directory (car dir-list))
                          (file-name-nondirectory file)))
-      
+
       (unless (file-exists-p found)
          (set 'found nil))
       (set 'dir-list (cdr dir-list)))
     found))
 
 (defun ada-find-ali-file-in-dir (file)
       (unless (file-exists-p found)
          (set 'found nil))
       (set 'dir-list (cdr dir-list)))
     found))
 
 (defun ada-find-ali-file-in-dir (file)
-  "Find an .ali file in obj_dir. The current buffer must be the Ada file.
+  "Find an .ali file in obj_dir.  The current buffer must be the Ada file.
 Adds build_dir in front of the search path to conform to gnatmake's behavior,
 and the standard runtime location at the end."
   (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
 
 (defun ada-find-src-file-in-dir (file)
 Adds build_dir in front of the search path to conform to gnatmake's behavior,
 and the standard runtime location at the end."
   (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
 
 (defun ada-find-src-file-in-dir (file)
-  "Find a source file in src_dir. The current buffer must be the Ada file.
+  "Find a source file in src_dir.  The current buffer must be the Ada file.
 Adds src_dir in front of the search path to conform to gnatmake's behavior,
 and the standard runtime location at the end."
   (ada-find-file-in-dir file (ada-xref-get-src-dir-field)))
 Adds src_dir in front of the search path to conform to gnatmake's behavior,
 and the standard runtime location at the end."
   (ada-find-file-in-dir file (ada-xref-get-src-dir-field)))
@@ -1464,7 +1398,7 @@ the project file."
   ;;      and look for this file
   ;;   2- If this file is found:
   ;;      grep the "^U" lines, and make sure we are not reading the
   ;;      and look for this file
   ;;   2- If this file is found:
   ;;      grep the "^U" lines, and make sure we are not reading the
-  ;;      .ali file for a spec file. If we are, go to step 3.
+  ;;      .ali file for a spec file.  If we are, go to step 3.
   ;;   3- If the file is not found or step 2 failed:
   ;;      find the name of the "other file", ie the body, and look
   ;;      for its associated .ali file by subtituing the extension
   ;;   3- If the file is not found or step 2 failed:
   ;;      find the name of the "other file", ie the body, and look
   ;;      for its associated .ali file by subtituing the extension
@@ -1472,9 +1406,9 @@ the project file."
   ;; We must also handle the case of separate packages and subprograms:
   ;;   4- If no ali file was found, we try to modify the file name by removing
   ;;      everything after the last '-' or '.' character, so as to get the
   ;; We must also handle the case of separate packages and subprograms:
   ;;   4- If no ali file was found, we try to modify the file name by removing
   ;;      everything after the last '-' or '.' character, so as to get the
-  ;;      ali file for the parent unit. If we found an ali file, we check that
+  ;;      ali file for the parent unit.  If we found an ali file, we check that
   ;;      it indeed contains the definition for the separate entity by checking
   ;;      it indeed contains the definition for the separate entity by checking
-  ;;      the 'D' lines. This is done repeatedly, in case the direct parent is
+  ;;      the 'D' lines.  This is done repeatedly, in case the direct parent is
   ;;      also a separate.
 
   (save-excursion
   ;;      also a separate.
 
   (save-excursion
@@ -1487,7 +1421,7 @@ the project file."
 
       ;; If we have a non-standard file name, and this is a spec, we first
       ;; look for the .ali file of the body, since this is the one that
 
       ;; If we have a non-standard file name, and this is a spec, we first
       ;; look for the .ali file of the body, since this is the one that
-      ;; contains the most complete information. If not found, we will do what
+      ;; contains the most complete information.  If not found, we will do what
       ;; we can with the .ali file for the spec...
 
       (if (not (string= (file-name-extension file) "ads"))
       ;; we can with the .ali file for the spec...
 
       (if (not (string= (file-name-extension file) "ads"))
@@ -1505,14 +1439,14 @@ the project file."
                         (file-name-nondirectory
                          (ada-other-file-name)))
                        ".ali"))))
                         (file-name-nondirectory
                          (ada-other-file-name)))
                        ".ali"))))
-      
+
 
       (setq ali-file-name
            (or ali-file-name
 
       (setq ali-file-name
            (or ali-file-name
-               
+
                ;;  Else we take the .ali file associated with the unit
                (ada-find-ali-file-in-dir short-ali-file-name)
                ;;  Else we take the .ali file associated with the unit
                (ada-find-ali-file-in-dir short-ali-file-name)
-               
+
 
                ;;  else we did not find the .ali file Second chance: in case
                ;;  the files do not have standard names (such as for instance
 
                ;;  else we did not find the .ali file Second chance: in case
                ;;  the files do not have standard names (such as for instance
@@ -1523,35 +1457,35 @@ the project file."
                          (file-name-nondirectory (ada-other-file-name)))
                         ".ali"))
 
                          (file-name-nondirectory (ada-other-file-name)))
                         ".ali"))
 
-               
+
                ;;  If we still don't have an ali file, try to get the one
                ;;  from the parent unit, in case we have a separate entity.
                (let ((parent-name (file-name-sans-extension
                                    (file-name-nondirectory file))))
                ;;  If we still don't have an ali file, try to get the one
                ;;  from the parent unit, in case we have a separate entity.
                (let ((parent-name (file-name-sans-extension
                                    (file-name-nondirectory file))))
-                 
+
                  (while (and (not ali-file-name)
                              (string-match "^\\(.*\\)[.-][^.-]*" parent-name))
                  (while (and (not ali-file-name)
                              (string-match "^\\(.*\\)[.-][^.-]*" parent-name))
-                   
+
                    (set 'parent-name (match-string 1 parent-name))
                    (set 'ali-file-name (ada-find-ali-file-in-dir
                                         (concat parent-name ".ali")))
                    )
                  ali-file-name)))
                    (set 'parent-name (match-string 1 parent-name))
                    (set 'ali-file-name (ada-find-ali-file-in-dir
                                         (concat parent-name ".ali")))
                    )
                  ali-file-name)))
-      
+
       ;; If still not found, try to recompile the file
       (if (not ali-file-name)
       ;; If still not found, try to recompile the file
       (if (not ali-file-name)
-         ;; recompile only if the user asked for this. and search the ali
-         ;; filename again. We avoid a possible infinite recursion by
+         ;; Recompile only if the user asked for this, and search the ali
+         ;; filename again.  We avoid a possible infinite recursion by
          ;; temporarily disabling the automatic compilation.
          ;; temporarily disabling the automatic compilation.
-         
+
          (if ada-xref-create-ali
              (setq ali-file-name
                    (concat (file-name-sans-extension (ada-xref-current file))
                            ".ali"))
 
          (if ada-xref-create-ali
              (setq ali-file-name
                    (concat (file-name-sans-extension (ada-xref-current file))
                            ".ali"))
 
-           (error "Ali file not found. Recompile your file"))
-      
-       
+           (error "`.ali' file not found; recompile your source file"))
+
+
        ;; same if the .ali file is too old and we must recompile it
        (if (and (file-newer-than-file-p file ali-file-name)
                 ada-xref-create-ali)
        ;; same if the .ali file is too old and we must recompile it
        (if (and (file-newer-than-file-p file ali-file-name)
                 ada-xref-create-ali)
@@ -1563,7 +1497,7 @@ the project file."
 
 (defun ada-get-ada-file-name (file original-file)
   "Create the complete file name (+directory) for FILE.
 
 (defun ada-get-ada-file-name (file original-file)
   "Create the complete file name (+directory) for FILE.
-The original file (where the user was) is ORIGINAL-FILE. Search in project
+The original file (where the user was) is ORIGINAL-FILE.  Search in project
 file for possible paths."
 
   (save-excursion
 file for possible paths."
 
   (save-excursion
@@ -1575,7 +1509,7 @@ file for possible paths."
          (set-buffer buffer)
        (find-file original-file)
        (ada-require-project-file)))
          (set-buffer buffer)
        (find-file original-file)
        (ada-require-project-file)))
-    
+
     ;; we choose the first possible completion and we
     ;; return the absolute file name
     (let ((filename (ada-find-src-file-in-dir file)))
     ;; we choose the first possible completion and we
     ;; return the absolute file name
     (let ((filename (ada-find-src-file-in-dir file)))
@@ -1583,7 +1517,7 @@ file for possible paths."
           (expand-file-name filename)
         (error (concat
                 (file-name-nondirectory file)
           (expand-file-name filename)
         (error (concat
                 (file-name-nondirectory file)
-                " not found in src_dir. Please check your project file")))
+                " not found in src_dir; please check your project file")))
 
       )))
 
 
       )))
 
@@ -1605,7 +1539,7 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
   ;; If at end of buffer (e.g the buffer is empty), error
   (if (>= (point) (point-max))
       (error "No identifier on point"))
   ;; If at end of buffer (e.g the buffer is empty), error
   (if (>= (point) (point-max))
       (error "No identifier on point"))
-  
+
   ;; goto first character of the identifier/operator (skip backward < and >
   ;; since they are part of multiple character operators
   (goto-char pos)
   ;; goto first character of the identifier/operator (skip backward < and >
   ;; since they are part of multiple character operators
   (goto-char pos)
@@ -1642,12 +1576,12 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
       (if (looking-at "[a-zA-Z0-9_]+")
           (set 'identifier (match-string 0))
         (error "No identifier around")))
       (if (looking-at "[a-zA-Z0-9_]+")
           (set 'identifier (match-string 0))
         (error "No identifier around")))
-    
+
     ;; Build the identlist
     (set 'identlist    (ada-make-identlist))
     (ada-set-name      identlist (downcase identifier))
     (ada-set-line      identlist
     ;; Build the identlist
     (set 'identlist    (ada-make-identlist))
     (ada-set-name      identlist (downcase identifier))
     (ada-set-line      identlist
-                      (number-to-string (count-lines (point-min) (point))))
+                      (number-to-string (count-lines 1 (point))))
     (ada-set-column    identlist
                       (number-to-string (1+ (current-column))))
     (ada-set-file      identlist (buffer-file-name))
     (ada-set-column    identlist
                       (number-to-string (1+ (current-column))))
     (ada-set-file      identlist (buffer-file-name))
@@ -1657,7 +1591,7 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
 (defun ada-get-all-references (identlist)
   "Completes and returns IDENTLIST with the information extracted
 from the ali file (definition file and places where it is referenced)."
 (defun ada-get-all-references (identlist)
   "Completes and returns IDENTLIST with the information extracted
 from the ali file (definition file and places where it is referenced)."
-  
+
   (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist)))
        declaration-found)
     (set-buffer ali-buffer)
   (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist)))
        declaration-found)
     (set-buffer ali-buffer)
@@ -1667,7 +1601,7 @@ from the ali file (definition file and places where it is referenced)."
     ;; First attempt: we might already be on the declaration of the identifier
     ;; We want to look for the declaration only in a definite interval (after
     ;; the "^X ..." line for the current file, and before the next "^X" line
     ;; First attempt: we might already be on the declaration of the identifier
     ;; We want to look for the declaration only in a definite interval (after
     ;; the "^X ..." line for the current file, and before the next "^X" line
-    
+
     (if (re-search-forward
         (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist)))
         nil t)
     (if (re-search-forward
         (concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist)))
         nil t)
@@ -1677,7 +1611,7 @@ from the ali file (definition file and places where it is referenced)."
                (concat "^"    (ada-line-of identlist)
                        "."    (ada-column-of identlist)
                        "[ *]" (ada-name-of identlist)
                (concat "^"    (ada-line-of identlist)
                        "."    (ada-column-of identlist)
                        "[ *]" (ada-name-of identlist)
-                       " \\(.*\\)$") bound t))
+                       "[{\(<= ]?\\(.*\\)$") bound t))
          (if declaration-found
              (ada-set-on-declaration identlist t))
          ))
          (if declaration-found
              (ada-set-on-declaration identlist t))
          ))
@@ -1686,7 +1620,7 @@ from the ali file (definition file and places where it is referenced)."
     ;; have to fall back on other algorithms
 
     (unless declaration-found
     ;; have to fall back on other algorithms
 
     (unless declaration-found
-      
+
       ;; Since we alread know the number of the file, search for a direct
       ;; reference to it
       (goto-char (point-min))
       ;; Since we alread know the number of the file, search for a direct
       ;; reference to it
       (goto-char (point-min))
@@ -1696,10 +1630,10 @@ from the ali file (definition file and places where it is referenced)."
        (number-to-string (ada-find-file-number-in-ali
                          (ada-file-of identlist))))
       (unless (re-search-forward (concat (ada-ali-index-of identlist)
        (number-to-string (ada-find-file-number-in-ali
                          (ada-file-of identlist))))
       (unless (re-search-forward (concat (ada-ali-index-of identlist)
-                                        "|\\([0-9]+.[0-9]+ \\)*"
+                                        "|\\([0-9]+[^0-9][0-9]+\\(\n\\.\\)? \\)*"
                                         (ada-line-of identlist)
                                         (ada-line-of identlist)
-                                        "[^0-9]"
-                                        (ada-column-of identlist))
+                                        "[^etpzkd<>=^]"
+                                        (ada-column-of identlist) "\\>")
                                 nil t)
 
           ;; if we did not find it, it may be because the first reference
                                 nil t)
 
           ;; if we did not find it, it may be because the first reference
@@ -1707,12 +1641,14 @@ from the ali file (definition file and places where it is referenced)."
           ;; Or maybe we are already on the declaration...
           (unless (re-search-forward
                   (concat
           ;; Or maybe we are already on the declaration...
           (unless (re-search-forward
                   (concat
-                   "^\\(\\([a-zA-Z0-9_.]+\\|\"[<>=+*-/a-z]\"\\)[ *]\\)*"
+                   "^[0-9]+.[0-9]+[ *]"
+                   (ada-name-of identlist)
+                   "[ <{=\(]\\(.\\|\n\\.\\)*\\<"
                    (ada-line-of identlist)
                    "[^0-9]"
                    (ada-line-of identlist)
                    "[^0-9]"
-                   (ada-column-of identlist))
+                   (ada-column-of identlist) "\\>")
                   nil t)
                   nil t)
-           
+
            ;; If still not found, then either the declaration is unknown
            ;; or the source file has been modified since the ali file was
            ;; created
            ;; If still not found, then either the declaration is unknown
            ;; or the source file has been modified since the ali file was
            ;; created
@@ -1729,17 +1665,17 @@ from the ali file (definition file and places where it is referenced)."
            (while (looking-at "^\\.")
              (previous-line 1))
            (unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
            (while (looking-at "^\\.")
              (previous-line 1))
            (unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
-                                       (ada-name-of identlist) "[ <]"))
+                                       (ada-name-of identlist) "[ <{=\(]"))
              (set 'declaration-found nil))))
 
       ;; Still no success ! The ali file must be too old, and we need to
              (set 'declaration-found nil))))
 
       ;; Still no success ! The ali file must be too old, and we need to
-      ;; use a basic algorithm based on guesses. Note that this only happens
+      ;; use a basic algorithm based on guesses.  Note that this only happens
       ;; if the user does not want us to automatically recompile files
       ;; automatically
       (unless declaration-found
        (if (ada-xref-find-in-modified-ali identlist)
            (set 'declaration-found t)
       ;; if the user does not want us to automatically recompile files
       ;; automatically
       (unless declaration-found
        (if (ada-xref-find-in-modified-ali identlist)
            (set 'declaration-found t)
-         ;; no more idea to find the declaration. Give up
+         ;; No more idea to find the declaration.  Give up
          (progn
            (kill-buffer ali-buffer)
            (error (concat "No declaration of " (ada-name-of identlist)
          (progn
            (kill-buffer ali-buffer)
            (error (concat "No declaration of " (ada-name-of identlist)
@@ -1747,7 +1683,7 @@ from the ali file (definition file and places where it is referenced)."
            )))
       )
 
            )))
       )
 
-    
+
     ;; Now that we have found a suitable line in the .ali file, get the
     ;; information available
     (beginning-of-line)
     ;; Now that we have found a suitable line in the .ali file, get the
     ;; information available
     (beginning-of-line)
@@ -1770,13 +1706,13 @@ from the ali file (definition file and places where it is referenced)."
                   identlist
                   (ada-get-ada-file-name (match-string 1)
                                          (ada-file-of identlist)))
                   identlist
                   (ada-get-ada-file-name (match-string 1)
                                          (ada-file-of identlist)))
-               
+
                ;;  Else clean up the ali file
                (error
                 (kill-buffer ali-buffer)
                 (error (error-message-string err)))
                ))
                ;;  Else clean up the ali file
                (error
                 (kill-buffer ali-buffer)
                 (error (error-message-string err)))
                ))
-         
+
          (ada-set-references   identlist current-line)
          ))
   ))
          (ada-set-references   identlist current-line)
          ))
   ))
@@ -1802,7 +1738,7 @@ This function is disabled for operators, and only works for identifiers."
           (goto-char (point-max))
           (while (re-search-backward my-regexp nil t)
             (save-excursion
           (goto-char (point-max))
           (while (re-search-backward my-regexp nil t)
             (save-excursion
-              (set 'line-ali (count-lines (point-min) (point)))
+              (set 'line-ali (count-lines 1 (point)))
               (beginning-of-line)
               ;; have a look at the line and column numbers
               (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
               (beginning-of-line)
               ;; have a look at the line and column numbers
               (if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
@@ -1829,16 +1765,16 @@ This function is disabled for operators, and only works for identifiers."
             (error (concat "No declaration of "
                            (ada-name-of identlist)
                            " recorded in .ali file")))
             (error (concat "No declaration of "
                            (ada-name-of identlist)
                            " recorded in .ali file")))
-          
+
            ;; one => should be the right one
            ((= len 1)
             (goto-line (caar declist)))
            ;; one => should be the right one
            ((= len 1)
             (goto-line (caar declist)))
-          
+
            ;; more than one => display choice list
            (t
            (save-window-excursion
              (with-output-to-temp-buffer "*choice list*"
            ;; more than one => display choice list
            (t
            (save-window-excursion
              (with-output-to-temp-buffer "*choice list*"
-               
+
                (princ "Identifier is overloaded and Xref information is not up to date.\n")
                (princ "Possible declarations are:\n\n")
                (princ "  no.   in file                at line  col\n")
                (princ "Identifier is overloaded and Xref information is not up to date.\n")
                (princ "Possible declarations are:\n\n")
                (princ "  no.   in file                at line  col\n")
@@ -1893,13 +1829,14 @@ opens a new window to show the declaration."
     (set 'locations (list (list (match-string 1 ali-line) ;; line
                                (match-string 2 ali-line) ;; column
                                (ada-declare-file-of identlist))))
     (set 'locations (list (list (match-string 1 ali-line) ;; line
                                (match-string 2 ali-line) ;; column
                                (ada-declare-file-of identlist))))
-    (while (string-match "\\([0-9]+\\)[bc]\\([0-9]+\\)" ali-line start)
+    (while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)"
+                        ali-line start)
       (setq line  (match-string 1 ali-line)
       (setq line  (match-string 1 ali-line)
-           col   (match-string 2 ali-line)
-           start (match-end 2))
+           col   (match-string 3 ali-line)
+           start (match-end 3))
 
       ;;  it there was a file number in the same line
 
       ;;  it there was a file number in the same line
-      (if (string-match (concat "\\([0-9]+\\)|\\([^|bc]+\\)?"
+      (if (string-match (concat "[^{(<]\\([0-9]+\\)|\\([^|bc]+\\)?"
                                (match-string 0 ali-line))
                        ali-line)
          (let ((file-number (match-string 1 ali-line)))
                                (match-string 0 ali-line))
                        ali-line)
          (let ((file-number (match-string 1 ali-line)))
@@ -1910,7 +1847,7 @@ opens a new window to show the declaration."
            )
        ;; Else get the nearest file
        (set 'file (ada-declare-file-of identlist)))
            )
        ;; Else get the nearest file
        (set 'file (ada-declare-file-of identlist)))
-      
+
       (set 'locations (append locations (list (list line col file)))))
 
     ;; Add the specs at the end again, so that from the last body we go to
       (set 'locations (append locations (list (list line col file)))))
 
     ;; Add the specs at the end again, so that from the last body we go to
@@ -1923,7 +1860,7 @@ opens a new window to show the declaration."
     (setq line (caar locations)
          col  (nth 1 (car locations))
          file (nth 2 (car locations)))
     (setq line (caar locations)
          col  (nth 1 (car locations))
          file (nth 2 (car locations)))
-    
+
     (while locations
       (if (and (string= (caar locations) (ada-line-of identlist))
               (string= (nth 1 (car locations)) (ada-column-of identlist))
     (while locations
       (if (and (string= (caar locations) (ada-line-of identlist))
               (string= (nth 1 (car locations)) (ada-column-of identlist))
@@ -1962,27 +1899,27 @@ This command requires the external `egrep' program to be available.
 This works well when one is using an external librarie and wants
 to find the declaration and documentation of the subprograms one is
 is using."
 This works well when one is using an external librarie and wants
 to find the declaration and documentation of the subprograms one is
 is using."
-  
+
   (let (list
        (dirs (ada-xref-get-obj-dir-field))
        (regexp (concat "[ *]" (ada-name-of identlist)))
        line column
        choice
        file)
   (let (list
        (dirs (ada-xref-get-obj-dir-field))
        (regexp (concat "[ *]" (ada-name-of identlist)))
        line column
        choice
        file)
-    
+
     (save-excursion
     (save-excursion
-      
-      ;;  Do the grep in all the directories. We do multiple shell
+
+      ;;  Do the grep in all the directories.  We do multiple shell
       ;;  commands instead of one in case there is no .ali file in one
       ;;  of the directory and the shell stops because of that.
       ;;  commands instead of one in case there is no .ali file in one
       ;;  of the directory and the shell stops because of that.
-      
+
       (set-buffer (get-buffer-create "*grep*"))
       (while dirs
        (insert (shell-command-to-string
                 (concat "egrep -i -h '^X|" regexp "( |$)' "
                         (file-name-as-directory (car dirs)) "*.ali")))
        (set 'dirs (cdr dirs)))
       (set-buffer (get-buffer-create "*grep*"))
       (while dirs
        (insert (shell-command-to-string
                 (concat "egrep -i -h '^X|" regexp "( |$)' "
                         (file-name-as-directory (car dirs)) "*.ali")))
        (set 'dirs (cdr dirs)))
-      
+
       ;;  Now parse the output
       (set 'case-fold-search t)
       (goto-char (point-min))
       ;;  Now parse the output
       (set 'case-fold-search t)
       (goto-char (point-min))
@@ -1996,23 +1933,23 @@ is using."
                      column (match-string 2))
                (re-search-backward "^X [0-9]+ \\(.*\\)$")
                (set 'file (list (match-string 1) line column))
                      column (match-string 2))
                (re-search-backward "^X [0-9]+ \\(.*\\)$")
                (set 'file (list (match-string 1) line column))
-         
+
                ;;  There could be duplicate choices, because of the structure
                ;;  of the .ali files
                (unless (member file list)
                  (set 'list (append list (list file))))))))
                ;;  There could be duplicate choices, because of the structure
                ;;  of the .ali files
                (unless (member file list)
                  (set 'list (append list (list file))))))))
-      
+
       ;;  Current buffer is still "*grep*"
       (kill-buffer "*grep*")
       )
       ;;  Current buffer is still "*grep*"
       (kill-buffer "*grep*")
       )
-    
+
     ;;  Now display the list of possible matches
     (cond
     ;;  Now display the list of possible matches
     (cond
-     
+
      ;;  No choice found => Error
      ((null list)
       (error "No cross-reference found, please recompile your file"))
      ;;  No choice found => Error
      ((null list)
       (error "No cross-reference found, please recompile your file"))
-     
+
      ;;  Only one choice => Do the cross-reference
      ((= (length list) 1)
       (set 'file (ada-find-src-file-in-dir (caar list)))
      ;;  Only one choice => Do the cross-reference
      ((= (length list) 1)
       (set 'file (ada-find-src-file-in-dir (caar list)))
@@ -2025,12 +1962,12 @@ is using."
        (error (concat (caar list) " not found in src_dir")))
       (message "This is only a (good) guess at the cross-reference.")
       )
        (error (concat (caar list) " not found in src_dir")))
       (message "This is only a (good) guess at the cross-reference.")
       )
-     
+
      ;;  Else, ask the user
      (t
       (save-window-excursion
        (with-output-to-temp-buffer "*choice list*"
      ;;  Else, ask the user
      (t
       (save-window-excursion
        (with-output-to-temp-buffer "*choice list*"
-         
+
          (princ "Identifier is overloaded and Xref information is not up to date.\n")
          (princ "Possible declarations are:\n\n")
          (princ "  no.   in file                at line  col\n")
          (princ "Identifier is overloaded and Xref information is not up to date.\n")
          (princ "Possible declarations are:\n\n")
          (princ "  no.   in file                at line  col\n")
@@ -2072,7 +2009,7 @@ is using."
   (file line column identlist &optional other-frame)
   "Select and display FILE, at LINE and COLUMN.
 If we do not end on the same identifier as IDENTLIST, find the closest
   (file line column identlist &optional other-frame)
   "Select and display FILE, at LINE and COLUMN.
 If we do not end on the same identifier as IDENTLIST, find the closest
-match. Kills the .ali buffer at the end.
+match.  Kills the .ali buffer at the end.
 If OTHER-FRAME is non-nil, creates a new frame to show the file."
 
   (let (declaration-buffer)
 If OTHER-FRAME is non-nil, creates a new frame to show the file."
 
   (let (declaration-buffer)
@@ -2231,7 +2168,7 @@ This function typically is to be hooked into `ff-file-created-hooks'."
     (progn
       (set-buffer-modified-p nil)
       (kill-buffer (current-buffer))))
     (progn
       (set-buffer-modified-p nil)
       (kill-buffer (current-buffer))))
-       
+
 
   ;;  Make sure the current buffer is the spec (this might not be the case
   ;;  if for instance the user was asked for a project file)
 
   ;;  Make sure the current buffer is the spec (this might not be the case
   ;;  if for instance the user was asked for a project file)
@@ -2239,7 +2176,7 @@ This function typically is to be hooked into `ff-file-created-hooks'."
   (unless (buffer-file-name (car (buffer-list)))
     (set-buffer (cadr (buffer-list))))
 
   (unless (buffer-file-name (car (buffer-list)))
     (set-buffer (cadr (buffer-list))))
 
-  ;;  Make sure we have a project file (for parameters to gnatstub). Note that
+  ;;  Make sure we have a project file (for parameters to gnatstub).  Note that
   ;;  this might have already been done if we have been called from the hook,
   ;;  but this is not an expensive call)
   (ada-require-project-file)
   ;;  this might have already been done if we have been called from the hook,
   ;;  but this is not an expensive call)
   (ada-require-project-file)
@@ -2287,17 +2224,13 @@ This function typically is to be hooked into `ff-file-created-hooks'."
   "Function called by `ada-mode-hook' to initialize the ada-xref.el package.
 For instance, it creates the gnat-specific menus, sets some hooks for
 find-file...."
   "Function called by `ada-mode-hook' to initialize the ada-xref.el package.
 For instance, it creates the gnat-specific menus, sets some hooks for
 find-file...."
-  (make-local-hook 'ff-file-created-hooks)
   ;; This should really be an `add-hook'.  -stef
   ;; This should really be an `add-hook'.  -stef
-  (setq ff-file-created-hooks 'ada-make-body-gnatstub)
-
-  ;; Read the project file and update the search path
-  ;; before looking for the other file
-  (make-local-hook 'ff-pre-find-hooks)
-  (add-hook 'ff-pre-find-hooks 'ada-require-project-file nil t)
+  (setq ff-file-created-hook 'ada-make-body-gnatstub)
 
   ;; Completion for file names in the mini buffer should ignore .ali files
   (add-to-list 'completion-ignored-extensions ".ali")
 
   ;; Completion for file names in the mini buffer should ignore .ali files
   (add-to-list 'completion-ignored-extensions ".ali")
+
+  (ada-xref-update-project-menu)
   )
 
 
   )
 
 
@@ -2305,9 +2238,9 @@ find-file...."
 
 ;;  Use gvd or ddd as the default debugger if it was found
 ;;  On windows, do not use the --tty switch for GVD, since this is
 
 ;;  Use gvd or ddd as the default debugger if it was found
 ;;  On windows, do not use the --tty switch for GVD, since this is
-;;  not supported. Actually, we do not use this on Unix either, since otherwise
-;;  there is no console window left in GVD, and people have to use the
-;;  Emacs one.
+;;  not supported.  Actually, we do not use this on Unix either,
+;;  since otherwise there is no console window left in GVD,
+;;  and people have to use the Emacs one.
 ;;  This must be done before initializing the Ada menu.
 (if (ada-find-file-in-dir "gvd" exec-path)
     (set 'ada-prj-default-debugger "gvd ")
 ;;  This must be done before initializing the Ada menu.
 (if (ada-find-file-in-dir "gvd" exec-path)
     (set 'ada-prj-default-debugger "gvd ")
@@ -2316,29 +2249,17 @@ find-file...."
   (if (ada-find-file-in-dir "ddd" exec-path)
       (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))
 
   (if (ada-find-file-in-dir "ddd" exec-path)
       (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))
 
-;;  Set the keymap once and for all, so that the keys set by the user in his
-;;  config file are not overwritten every time we open a new file.
-(ada-add-ada-menu)
-(ada-add-keymap)
-
 (add-hook 'ada-mode-hook 'ada-xref-initialize)
 
 ;;  Initializes the cross references to the runtime library
 (ada-initialize-runtime-library "")
 
 ;;  Add these standard directories to the search path
 (add-hook 'ada-mode-hook 'ada-xref-initialize)
 
 ;;  Initializes the cross references to the runtime library
 (ada-initialize-runtime-library "")
 
 ;;  Add these standard directories to the search path
-(set 'ada-search-directories
+(set 'ada-search-directories-internal
      (append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path)
             ada-search-directories))
 
      (append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path)
             ada-search-directories))
 
-;;  Make sure that the files are always associated with a project file. Since
-;;  the project file has some fields that are used for the editor (like the
-;;  casing exceptions), it has to be read before the user edits a file).
-(add-hook 'ada-mode-hook
-         (lambda()
-           (let ((file (ada-prj-find-prj-file t)))
-             (if file (ada-reread-prj-file file)))))
-
 (provide 'ada-xref)
 
 (provide 'ada-xref)
 
+;;; arch-tag: 415a39fe-577b-4676-b3b1-6ff6db7ca24e
 ;;; ada-xref.el ends here
 ;;; ada-xref.el ends here