(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 d358a127d8ca54fe053d862d448c084fcc303063..fc1d2d46ab37b7cbabca94b56410841100f12e74 100644 (file)
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -1,66 +1,51 @@
-;; @(#) ada-xref.el --for lookup and completion in Ada mode
+;;; ada-xref.el --- for lookup and completion in Ada mode

 
 

-;; Copyright (C) 1994-1999 Free Software Foundation, Inc.
+;; 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>
 
 ;; 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.99 $
+;; Ada Core Technologies's version:   Revision: 1.181

 ;; Keywords: languages ada xref
 
 ;; Keywords: languages ada xref
 

-;; This file is not part of GNU Emacs.
+;; This file is part of GNU Emacs.

 
 

-;; This program is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software; you can redistribute it and/or modify

 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 

-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,

 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.

 
 ;;; Commentary:
 ;;; This Package provides a set of functions to use the output of the
 ;;; cross reference capabilities of the GNAT Ada compiler
 ;;; for lookup and completion in Ada mode.
 ;;;
 
 ;;; Commentary:
 ;;; This Package provides a set of functions to use the output of the
 ;;; cross reference capabilities of the GNAT Ada compiler
 ;;; for lookup and completion in Ada mode.
 ;;;

-;;; The functions provided are the following ones :
-;;;    - `ada-complete-identifier': completes the current identifier as much as
-;;;      possible, depending of the known identifier in the unit
-;;;    - `ada-point-and-xref': moves the mouse pointer and shows the declaration
-;;;      of the selected identifier (either in the same buffer or in another
-;;;      buffer
-;;;    - `ada-goto-declaration': shows the declaration of the selected
-;;;      identifier (the one under the cursor), either in the same buffer or in
-;;;      another buffer
-;;;    - `ada-goto-declaration-other-frame': same as previous, but opens a new
-;;      frame to show the declaration
-;;;    - `ada-compile-application': recompile your whole application, provided
-;;;      that a project file exists in your directory
-;;;    - `ada-run-application': run your application directly from Emacs
-;;;    - `ada-reread-prj-file': force Emacs to read your project file again.
-;;;      Otherwise, this file is only read the first time Emacs needs some
-;;;      informations, which are then kept in memory
-;;;    - `ada-change-prj': change the prj file associated with a buffer
-;;;    - `ada-change-default-prj': change the default project file used for
-;;;      every new buffer
-;;;

 ;;; If a file *.`adp' exists in the ada-file directory, then it is
 ;;; 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
 

+;;; Code:
+

 ;; ----- Requirements -----------------------------------------------------
 
 (require 'compile)
 (require 'comint)
 ;; ----- Requirements -----------------------------------------------------
 
 (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


@@ -68,22 +53,31 @@
 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-prj-default-comp-opt "-gnatq"
+(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)
 
   "Default compilation options."
   :type 'string :group 'ada)
 


@@ -96,18 +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"
+  "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.
+The command `gnatfind' is used every time you choose the menu
+\"Show all references\"."

   :type 'string :group 'ada)
 
 (defcustom ada-prj-default-comp-cmd
   :type 'string :group 'ada)
 
 (defcustom ada-prj-default-comp-cmd

-  "${cross_prefix}gcc -c ${comp_opt}"
+  (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)
 


@@ -125,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)
 


@@ -134,6 +137,34 @@ This has the same syntax as in the project file (with variable substitution)."
 Otherwise, ask the user for the name of the project file to use."
   :type 'boolean :group 'ada)
 
 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)))
+  "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.
+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 ""
   "Name of the last project file entered by the user.")
 ;; ------- Nothing to be modified by the user below this
 (defvar ada-last-prj-file ""
   "Name of the last project file entered by the user.")


@@ -141,12 +172,9 @@ Otherwise, ask the user for the name of the project file to use."
 (defvar ada-check-switch "-gnats"
   "Switch added to the command line to check the current file.")
 
 (defvar ada-check-switch "-gnats"
   "Switch added to the command line to check the current file.")
 

-(defvar ada-project-file-extension ".adp"
+(defconst ada-project-file-extension ".adp"

   "The extension used for project files.")
 
   "The extension used for project files.")
 

-(defconst is-windows (memq system-type (quote (windows-nt)))
-  "True if we are running on windows NT or windows 95.")
-

 (defvar ada-xref-runtime-library-specs-path '()
   "Directories where the specs for the standard library is found.
 This is used for cross-references.")
 (defvar ada-xref-runtime-library-specs-path '()
   "Directories where the specs for the standard library is found.
 This is used for cross-references.")


@@ -159,6 +187,19 @@ This is used for cross-references.")
   "List of positions selected by the cross-references functions.
 Used to go back to these positions.")
 
   "List of positions selected by the cross-references functions.
 Used to go back to these positions.")
 

+(defvar ada-cd-command
+  (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.")
+
+(defvar ada-command-separator (if is-windows " && " "\n")
+  "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
   "Number of positions kept in the list ada-xref-pos-ring.")
 
 (defconst ada-xref-pos-ring-max 16
   "Number of positions kept in the list ada-xref-pos-ring.")
 


@@ -166,35 +207,53 @@ Used to go back to these positions.")
   "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"
   "Regexp to match for operators.")
 
   "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"
   "Regexp to match for operators.")
 

-(defvar ada-xref-default-prj-file nil
-  "Name of the default prj file, per directory.
-Every directory is potentially associated with a default project file.
-If it is nil, then the first prj file loaded will be the default for this
-Emacs session.")
-
-

 (defvar ada-xref-project-files '()
   "Associative list of project files.
 It has the following format:
 (defvar ada-xref-project-files '()
   "Associative list of project files.
 It has the following format:

-((project_name . value) (project_name . value) ...)
+\((project_name . value) (project_name . value) ...)

 As always, the values of the project file are defined through properties.")
 
 As always, the values of the project file are defined through properties.")
 

-(defvar ada-prj-prj-file nil
-  "Buffer local variable that specifies the name of the project file.
-Getting the project is done by looking up the key in ada-pxref-project-file.")

 
 

-(defun my-local-variable-if-set-p (variable &optional buffer)
-  "Returns t if VARIABLE is local in BUFFER and is non-nil."
-  (and (local-variable-p variable buffer)
-       (save-excursion
-         (set-buffer buffer)
-         (symbol-value variable))))
+;; ----- 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-initialize-runtime-library ()
-  "Initializes the variables for the runtime library location."
+(defun ada-quote-cmd (cmd)
+  "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)
+  "Initialize the variables for the runtime library location.
+CROSS-PREFIX is the prefix to use for the gnatls command."

   (save-excursion
   (save-excursion

-    (set 'ada-xref-runtime-library-specs-path '())
-    (set 'ada-xref-runtime-library-ali-path '())
+    (setq ada-xref-runtime-library-specs-path '()
+         ada-xref-runtime-library-ali-path   '())

     (set-buffer (get-buffer-create "*gnatls*"))
     (widen)
     (erase-buffer)
     (set-buffer (get-buffer-create "*gnatls*"))
     (widen)
     (erase-buffer)


@@ -203,16 +262,18 @@ Getting the project is done by looking up the key in ada-pxref-project-file.")
        ;;  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 "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)


@@ -220,12 +281,13 @@ Getting the project is done by looking up the key in ada-pxref-project-file.")
                (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)


@@ -245,23 +307,34 @@ Getting the project is done by looking up the key in ada-pxref-project-file.")
   "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.
 The project file must have been loaded first.
 As a special case, ${current} is replaced with the name of the currently
   "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.
 The project file must have been loaded first.
 As a special case, ${current} is replaced with the name of the currently

-edited file, minus extension but with directory."
+edited file, minus extension but with directory, and ${full_current} is
+replaced by the name including the extension."

 
   (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string)
 
   (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string)

-    (let (value)
-      (if (string= (match-string 2 cmd-string) "current")
-         (set 'value (file-name-sans-extension (buffer-file-name)))
+    (let (value
+         (name (match-string 2 cmd-string)))
+      (cond
+       ((string= name "current")
+       (setq value (file-name-sans-extension (buffer-file-name))))
+       ((string= name "full_current")
+       (setq value (buffer-file-name)))
+       (t

        (save-match-data
        (save-match-data

-         (set 'value (ada-xref-get-project-field
-                      (intern (match-string 2 cmd-string))))))
+         (setq value (ada-xref-get-project-field (intern name))))))
+
+      ;; Check if there is an environment variable with the same name
+      (if (null value)
+         (if (not (setq value (getenv name)))
+             (message (concat "No environment variable " name " found"))))
+

       (cond
        ((null value)
       (cond
        ((null value)

-       (set 'cmd-string (replace-match "" t t cmd-string)))
+       (setq cmd-string (replace-match "" t t cmd-string)))

        ((stringp value)
        ((stringp value)

-       (set 'cmd-string (replace-match value t t cmd-string)))
+       (setq cmd-string (replace-match value t t cmd-string)))

        ((listp value)
        (let ((prefix (match-string 1 cmd-string)))
        ((listp value)
        (let ((prefix (match-string 1 cmd-string)))

-         (set 'cmd-string (replace-match
+         (setq cmd-string (replace-match

                            (mapconcat (lambda(x) (concat prefix x)) value " ")
                            t t cmd-string)))))
       ))
                            (mapconcat (lambda(x) (concat prefix x)) value " ")
                            t t cmd-string)))))
       ))


@@ -274,22 +347,21 @@ edited file, minus extension but with directory."
        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
       (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        (cond
-                                  (file
-                                   (ada-prj-get-prj-dir file))
-                                  (ada-prj-prj-file
-                                   ada-prj-prj-file)
-                                  (ada-xref-default-prj-file
-                                   ada-xref-default-prj-file)
-                                  (t
-                                   (error (concat "Not editing an Ada file,"
-                                                  "and no default project "
-                                                  "file specified!"))))
+          (list 'filename (expand-file-name
+                           (cond
+                            (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 "
+                                              "file specified!"))
+                             "")))

                 'build_dir       (file-name-as-directory (expand-file-name "."))
                 'src_dir         (list ".")
                 'obj_dir         (list ".")
                 'build_dir       (file-name-as-directory (expand-file-name "."))
                 'src_dir         (list ".")
                 'obj_dir         (list ".")


@@ -300,8 +372,10 @@ edited file, minus extension but with directory."
                 'bind_opt        ada-prj-default-bind-opt
                 'link_opt        ada-prj-default-link-opt
                 'gnatmake_opt    ada-prj-default-gnatmake-opt
                 'bind_opt        ada-prj-default-bind-opt
                 'link_opt        ada-prj-default-link-opt
                 'gnatmake_opt    ada-prj-default-gnatmake-opt

+                'gnatfind_opt    ada-prj-gnatfind-switches

                 'main            (if file
                 'main            (if file

-                                     (file-name-sans-extension file)
+                                     (file-name-nondirectory
+                                      (file-name-sans-extension file))

                                    "")
                 'main_unit       (if file
                                      (file-name-nondirectory
                                    "")
                 'main_unit       (if file
                                      (file-name-nondirectory


@@ -309,37 +383,40 @@ edited file, minus extension but with directory."
                                    "")
                 'cross_prefix    ""
                 'remote_machine  ""
                                    "")
                 'cross_prefix    ""
                 'remote_machine  ""

-                'comp_cmd        (concat "cd ${build_dir} && "
-                                         ada-prj-default-comp-cmd)
-                'check_cmd       (concat ada-prj-default-comp-cmd " "
-                                         ada-check-switch)
-                'make_cmd        (concat "cd ${build_dir} && "
-                                         ada-prj-default-make-cmd)
-                'run_cmd         (concat "cd ${build_dir} && ${main}"
-                                         (if is-windows ".exe"))
+                'comp_cmd        (list (concat ada-cd-command " ${build_dir}")
+                                       ada-prj-default-comp-cmd)
+                'check_cmd       (list (concat ada-prj-default-comp-cmd " "
+                                               ada-check-switch))
+                'make_cmd        (list (concat ada-cd-command " ${build_dir}")
+                                       ada-prj-default-make-cmd)
+                'run_cmd         (list (concat ada-cd-command " ${build_dir}")
+                                       (concat "${main}"
+                                               (if is-windows ".exe")))
+                'debug_pre_cmd   (list (concat ada-cd-command
+                                               " ${build_dir}"))

                 'debug_cmd       (concat ada-prj-default-debugger
                                          (if is-windows " ${main}.exe"
                 'debug_cmd       (concat ada-prj-default-debugger
                                          (if is-windows " ${main}.exe"

-                                           " ${main}"))))
+                                           " ${main}"))
+                'debug_post_cmd  (list nil)))

       )
     (set symbol plist)))
       )
     (set symbol plist)))

-  
+

 (defun ada-xref-get-project-field (field)
 (defun ada-xref-get-project-field (field)

-  "Extract the value of FIELD from the project file of the current buffer.
+  "Extract the value of FIELD from the current project file.

 The project file must have been loaded first.
 The project file must have been loaded first.

-A default value is returned if the file was not found."
+A default value is returned if the file was not found.
+
+Note that for src_dir and obj_dir, you should rather use
+`ada-xref-get-src-dir-field' or `ada-xref-get-obj-dir-field' which will in
+addition return the default paths."

 
 

-  (let ((file-name ada-prj-prj-file)
+  (let ((file-name ada-prj-default-project-file)

        file value)
 
        file value)
 

-    ;;  If a default project file was set, use it if no other project
-    ;;  file was specified for the buffer
-    (if (and (not file-name) 
-            ada-prj-default-project-file
-            (not (string= ada-prj-default-project-file "")))
-       (set 'file-name ada-prj-default-project-file))
-    
-    (set 'file (assoc file-name 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


@@ -348,214 +425,147 @@ A default value is returned if the file was not found."
       ;; Create a default nil file that contains the default values
       (ada-xref-set-default-prj-values 'value (current-buffer))
       (add-to-list 'ada-xref-project-files (cons nil value))
       ;; Create a default nil file that contains the default values
       (ada-xref-set-default-prj-values 'value (current-buffer))
       (add-to-list 'ada-xref-project-files (cons nil value))

+      (ada-xref-update-project-menu)

       (set 'value (plist-get value field))
       )
       (set 'value (plist-get value field))
       )

-    (if (stringp value)
-       (ada-treat-cmd-string value)
-      value))
-  )

 
 

-;; ----- Keybindings ------------------------------------------------------
+    ;;  Substitute the ${...} constructs in all the strings, including
+    ;;  inside lists
+    (cond
+     ((stringp value)
+      (ada-treat-cmd-string value))
+     ((null value)
+      nil)
+     ((listp value)
+      (mapcar (lambda(x) (if x (ada-treat-cmd-string x) x)) value))
+     (t
+      value)
+     )
+  ))

 
 

-(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-cb"  'ada-buffer-list)
-  (define-key ada-mode-map "\C-cc"  'ada-change-prj)
-  (define-key ada-mode-map "\C-cd"  'ada-change-default-prj)
-  (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)
-  )

 
 

-;; ----- 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-submenu)
-                menu-list '("Project"
-                            ["Associate"   ada-change-prj t]
-                            ["Set Default..." ada-set-default-project-file t]
-                            ["List" ada-buffer-list 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])
-       )
-    
-    ;; 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"
-             (funcall (symbol-function 'easy-menu-create-menu)
-                      "Project"
-                      '(["Associate..."   ada-change-prj t
-                         :included (string= mode-name "Ada")]
-                        ["Set Default..." ada-set-default-project-file t]
-                        ["List"        ada-buffer-list t])))
-       '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 [gdb]
-        '("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)
-      )
-    )
-  )
+(defun ada-xref-get-src-dir-field ()
+  "Return the full value for src_dir, including the default directories.
+All the directories are returned as absolute directories."
+
+  (let ((build-dir (ada-xref-get-project-field '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)
+
+     ;; Add the standard runtime at the end
+     ada-xref-runtime-library-specs-path)))
+
+(defun ada-xref-get-obj-dir-field ()
+  "Return the full value for obj_dir, including the default directories.
+All the directories are returned as absolute directories."
+
+  (let ((build-dir (ada-xref-get-project-field '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)
+
+     ;; 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."
+  ;; 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)))
+
+
+;;-------------------------------------------------------------
+;;--  Searching a file anywhere on the source path.
+;;--
+;;--  The following functions provide support for finding a file anywhere
+;;--  on the source path, without providing an explicit directory.
+;;--  They also provide file name completion in the minibuffer.
+;;--
+;;--  Public subprograms:  ada-find-file
+;;--
+;;-------------------------------------------------------------
+
+(defun ada-do-file-completion (string predicate flag)
+  "Completion function when reading a file from the minibuffer.
+Completion is attempted in all the directories in the source path, as
+defined in the project file."
+  (let (list
+       (dirs (ada-xref-get-src-dir-field)))
+
+    (while dirs
+      (if (file-directory-p (car dirs))
+         (set 'list (append list (file-name-all-completions string (car dirs)))))
+      (set 'dirs (cdr dirs)))
+    (cond ((equal flag 'lambda)
+          (assoc string list))
+         (flag
+          list)
+         (t
+          (try-completion string
+                          (mapcar (lambda (x) (cons x 1)) list)
+                     predicate)))))
+
+;;;###autoload
+(defun ada-find-file (filename)
+  "Open a file anywhere in the source path.
+Completion is available."
+  (interactive
+   (list (completing-read "File: " 'ada-do-file-completion)))
+  (let ((file (ada-find-src-file-in-dir filename)))
+    (if file
+       (find-file file)
+      (error (concat filename " not found in src_dir")))))
+

 
 ;; ----- Utilities -------------------------------------------------
 
 (defun ada-require-project-file ()
 
 ;; ----- Utilities -------------------------------------------------
 
 (defun ada-require-project-file ()

-  "If no project file is assigned to this buffer, load one."
-  (if (not (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer)))
+  "If no project file is currently active, load a default one."
+  (if (or (not ada-prj-default-project-file)
+         (not ada-xref-project-files)
+         (string= ada-prj-default-project-file ""))

       (ada-reread-prj-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))


@@ -576,120 +586,110 @@ 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:")

-
-  ;;  All the directories should use this file as the default from now on,
-  ;;  even if they were already associated with a file.
-  (set 'ada-xref-default-prj-file nil)
-
-  (set 'ada-prj-default-project-file name)
-
-  ;; Make sure that all the buffers see the new project file, even if they
-  ;; are not Ada buffers (for instance if we want to display the current
-  ;; project file in the frame title).
-  (setq-default ada-prj-prj-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)
 
 
   (let (selected)
 

-    ;;  If we don't have an ada buffer, or the current buffer is not
-    ;;  a real file (for instance an emerge buffer)
-    
+    ;;  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"))
            (not (buffer-file-name)))
 
     (if (or (not (string= mode-name "Ada"))
            (not (buffer-file-name)))
 

-       ;;  1st case: not an Ada buffer

        (if (and ada-prj-default-project-file
                 (not (string= ada-prj-default-project-file "")))
        (if (and ada-prj-default-project-file
                 (not (string= ada-prj-default-project-file "")))

-           (set 'selected ada-prj-default-project-file))
-      
-      ;;  2nd case: If the buffer already has a project file, use it
-      (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))
-         (set 'selected ada-prj-prj-file)
-       
-       (let* ((current-file (buffer-file-name))
-              (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)
-              (prj-files    (directory-files
-                             dir t
-                             (concat ".*" (regexp-quote ada-project-file-extension) "$")))
-              (choice       nil)
-              (default      (assoc dir ada-xref-default-prj-file)))
-         
-         (cond
-          
-          ;;  3rd case: a project file is already associated with the directory
-          (default
-            (set 'selected (cdr default)))
-          
-          ;;  4th case: the user has set a default project file for every file
-          ((and ada-prj-default-project-file
-                (not (string= ada-prj-default-project-file "")))
-           (set 'selected ada-prj-default-project-file))
-          
-          ;;  5th case: 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))
-          
-          ;;  6th case: only one project file was found in the current directory
-          ((= (length prj-files) 1)
-           (set 'selected (car prj-files)))
-          
-          ;;  7th case: if there are multiple files, ask the user
-          ((and (> (length prj-files) 1) (not no-user-question))
-           (save-window-excursion
-             (with-output-to-temp-buffer "*choice list*"
-               (princ "There are more than one possible project file. Which one should\n")
-               (princ "be used ?\n\n")
-               (princ "  no.   file name  \n")
-               (princ "  ---   ------------------------\n")
-               (let ((counter 1))
-                 (while (<= counter (length prj-files))
-                   (princ (format "  %2d)    %s\n"
-                                  counter
-                                  (nth (1- counter) prj-files)))
-                   (setq counter (1+ counter))
-                   ))) ; end of with-output-to ...
-             (setq choice nil)
-             (while (or
-                     (not choice)
-                     (not (integerp choice))
-                     (< choice 1)
-                     (> choice (length prj-files)))
-               (setq choice (string-to-int
-                             (read-from-minibuffer "Enter No. of your choice: "))))
-             (set 'selected (nth (1- choice) prj-files))))
-          
-          ;; 8th case: 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
-          ((= (length prj-files) 0)
-           (unless (or no-user-question (not ada-always-ask-project))
-             (setq ada-last-prj-file
-                   (read-file-name "project file:" nil ada-last-prj-file))
-             (unless (string= ada-last-prj-file "")
-               (set 'selected ada-last-prj-file))))
-          ))))
-    selected
+           (setq selected ada-prj-default-project-file)
+         (setq selected nil))
+
+      ;;  other cases: use a more complex algorithm
+
+      (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))
+
+            ;; on Emacs 20.2, directory-files does not work if
+            ;; parse-sexp-lookup-properties is set
+            (parse-sexp-lookup-properties nil)
+            (prj-files    (directory-files
+                           dir t
+                           (concat ".*" (regexp-quote
+                                         ada-project-file-extension) "$")))
+            (choice       nil))
+
+       (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 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
+           (with-output-to-temp-buffer "*choice list*"
+             (princ "There are more than one possible project file.\n")
+             (princ "Which one should we use ?\n\n")
+             (princ "  no.   file name  \n")
+             (princ "  ---   ------------------------\n")
+             (let ((counter 1))
+               (while (<= counter (length prj-files))
+                 (princ (format "  %2d)    %s\n"
+                                counter
+                                (nth (1- counter) prj-files)))
+                 (setq counter (1+ counter))
+
+                 ))) ; end of with-output-to ...
+           (setq choice nil)
+           (while (or
+                   (not choice)
+                   (not (integerp choice))
+                   (< choice 1)
+                   (> choice (length 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
+        ((= (length prj-files) 0)
+         (unless (or no-user-question (not ada-always-ask-project))
+           (setq ada-last-prj-file
+                 (read-file-name
+                  (concat "project file [" ada-last-prj-file "]:")
+                  nil ada-last-prj-file))
+           (unless (string= ada-last-prj-file "")
+             (set 'selected ada-last-prj-file))))
+        )))
+
+    (or selected "default.adp")

     ))
 
 
     ))
 
 


@@ -697,93 +697,156 @@ file. If none is set, return nil."
   "Reads and parses the PRJ-FILE file if it was found.
 The current buffer should be the ada-file buffer."
   (if prj-file
   "Reads and parses the PRJ-FILE file if it was found.
 The current buffer should be the ada-file buffer."
   (if prj-file

-      (let (project src_dir obj_dir casing
+      (let (project src_dir obj_dir make_cmd comp_cmd check_cmd casing
+                   run_cmd debug_pre_cmd debug_post_cmd

             (ada-buffer (current-buffer)))
             (ada-buffer (current-buffer)))

-       (set 'prj-file (expand-file-name prj-file))
+       (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)))))
-              (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  casing)))
+       (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))

 
        ;;  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)))

-       
+

        ;; Sets up the compilation-search-path so that Emacs is able to
        ;; go to the source of the errors in a compilation buffer
        ;; 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-get-absolute-dir-list
-                                      (plist-get project 'src_dir)
-                                      (plist-get project 'build_dir)))
-       
-       ;;  Associate each source directory in the project file with this file
-       (mapcar (lambda (x)
-                 (if (not (assoc (expand-file-name x)
-                                 ada-xref-default-prj-file))
-                     (setq ada-xref-default-prj-file
-                           (cons (cons (expand-file-name x) prj-file)
-                                 ada-xref-default-prj-file))))
-               compilation-search-path)
-       
+       (setq compilation-search-path (ada-xref-get-src-dir-field))
+
+        ;; Set the casing exceptions file list
+        (if casing
+            (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

-       (set (make-local-variable 'ff-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)
-
-       ;;  Setup the project file for the current buffer
-       (set (make-local-variable 'ada-prj-prj-file) prj-file)

 
 

+       (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 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))


@@ -797,149 +860,86 @@ 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)
 

-  (let* ((command (concat "gnatfind -rf " entity
+  ;;  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
+         (if (= (aref entity 0) ?\")
+             (if is-windows
+                 (concat "\\\"" (substring entity 1 -1) "\\\"")
+               (concat "'\"" (substring entity 1 -1) "\"'"))
+           entity))
+        (switches (ada-xref-get-project-field 'gnatfind_opt))
+        (command (concat "gnat find " switches " "
+                         quote-entity

                           (if file (concat ":" (file-name-nondirectory file)))
                           (if line (concat ":" line))
                           (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 a project file is defined, use it

-    (if (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))
-        (setq command (concat command " -p" ada-prj-prj-file)))
+    (if (and ada-prj-default-project-file
+            (not (string= 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))))

 
 

-    (compile-internal command "No more references" "gnatfind")
+    (if (and append (get-buffer "*gnatfind*"))
+       (save-excursion
+         (set-buffer "*gnatfind*")
+         (setq old-contents (buffer-string))))
+
+    (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]))
-    )
-  )
-
-(defun ada-buffer-list ()
-  "Display a buffer with all the Ada buffers and their associated project."
-  (interactive)
-  (save-excursion
-    (set-buffer (get-buffer-create "*Buffer List*"))
-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (setq standard-output (current-buffer))
-    (princ "The following line is a list showing the associations between
-directories and project file. It has the format : ((directory_1 . project_file1)
-(directory2 . project_file2)...)\n\n")
-    (princ ada-xref-default-prj-file)
-    (princ "\n
- Buffer              Mode         Project file
- ------              ----         ------------
-\n")
-    (let ((bl (buffer-list)))
-      (while bl
-        (let* ((buffer (car bl))
-               (buffer-name (buffer-name buffer))
-               this-buffer-mode-name
-               this-buffer-project-file)
-          (save-excursion
-            (set-buffer buffer)
-            (setq this-buffer-mode-name
-                  (if (eq buffer standard-output)
-                      "Buffer Menu" mode-name))
-            (if (string= this-buffer-mode-name
-                         "Ada")
-                (setq this-buffer-project-file
-                      (if ( my-local-variable-if-set-p 'ada-prj-prj-file
-                                                   (current-buffer))
-                          (expand-file-name ada-prj-prj-file)
-                        ""))))
-          (if (string= this-buffer-mode-name
-                         "Ada")
-              (progn
-                (princ (format "%-19s  "  buffer-name))
-                  (princ (format "%-6s " this-buffer-mode-name))
-                  (princ this-buffer-project-file)
-                  (princ "\n")
-                  ))
-          ) ;; end let*
-        (setq bl (cdr bl))
-        ) ;; end while
-      );; end let
-    ) ;; end save-excursion
-  (display-buffer "*Buffer List*")
-  (other-window 1)
-  )
-
-(defun ada-change-prj (filename)
-  "Set FILENAME to be the project file for current buffer."
-  (interactive "fproject file:")
+      (local-unset-key [menu-bar compilation-menu])

 
 

-  ;; make sure we are using an Ada file
-  (if (not (string= mode-name "Ada"))
-    (error "You must be in ada-mode to use this function"))
-
-  (set (make-local-variable 'ada-prj-prj-file) filename)
-  (ada-parse-prj-file filename)
+      (if old-contents
+         (progn
+           (goto-char 1)
+           (insert old-contents)
+           (goto-char (point-max)))))
+    )

   )
 
   )
 

-(defun ada-change-default-prj (filename)
-  "Set FILENAME to be the default project file for the current directory."
-  (interactive "ffile name:")
-  (let ((dir (file-name-directory (buffer-file-name)))
-       (prj (expand-file-name filename)))
-
-    ;;  Associate the directory with a project file
-    (if (assoc dir ada-xref-default-prj-file)
-       (setcdr (assoc dir ada-xref-default-prj-file) prj)
-      (add-to-list 'ada-xref-default-prj-file (list dir prj)))
-
-    ;; Reparse the project file
-    (ada-parse-prj-file filename)))
-
-
-;; ----- 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)))
-
-
+(defalias 'ada-change-prj (symbol-function 'ada-set-default-project-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)
 


@@ -977,29 +977,65 @@ 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-goto-declaration (pos)
+(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
   "Display the declaration of the identifier around POS.
 The declaration is shown in another buffer if `ada-xref-other-buffer' is

-non-nil."
+non-nil.
+If OTHER-FRAME is non-nil, display the cross-reference in another frame."

   (interactive "d")
   (ada-require-project-file)
   (push-mark pos)
   (ada-xref-push-pos (buffer-file-name) pos)
   (interactive "d")
   (ada-require-project-file)
   (push-mark pos)
   (ada-xref-push-pos (buffer-file-name) pos)

-  (ada-find-in-ali (ada-read-identifier pos)))
+
+  ;;  First try the standard algorithm by looking into the .ali file, but if
+  ;;  that file was too old or even did not exist, try to look in the whole
+  ;;  object path for a possible location.
+  (let ((identlist (ada-read-identifier pos)))
+    (condition-case nil
+       (ada-find-in-ali identlist 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")
 
 (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")

-  (ada-require-project-file)
-  (push-mark pos)
-  (ada-xref-push-pos (buffer-file-name) pos)
-  (ada-find-in-ali (ada-read-identifier pos) t))
+  (ada-goto-declaration pos t))

 
 (defun ada-remote (command)
   "Return the remote version of COMMAND, or COMMAND if remote_machine is nil."
 
 (defun ada-remote (command)
   "Return the remote version of COMMAND, or COMMAND if remote_machine is nil."


@@ -1011,46 +1047,40 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
              machine
              command))))
 
              machine
              command))))
 

-(defun ada-get-absolute-dir (dir root-dir)
-  "Returns the absolute directory corresponding to DIR.
-If DIR is a relative directory, the value of ROOT-DIR is added in front."
-  (if (= (string-to-char dir) ?/)
-      dir
-    (concat root-dir dir)))
-

 (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."
-  (mapcar (lambda (x) (ada-get-absolute-dir x root-dir)) dir-list))
+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 ()
 
 (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"))
        (objects   (getenv "ADA_OBJECTS_PATH"))
        (build-dir (ada-xref-get-project-field 'build_dir)))
     (if include
 It modifies the source path and object path with the values found in the
 project file."
   (let ((include   (getenv "ADA_INCLUDE_PATH"))
        (objects   (getenv "ADA_OBJECTS_PATH"))
        (build-dir (ada-xref-get-project-field 'build_dir)))
     (if include

-       (set 'include (concat include path-separator)))
+       (set 'include (concat path-separator include)))

     (if objects
     (if objects

-       (set 'objects (concat objects path-separator)))
+       (set 'objects (concat path-separator objects)))

     (cons
      (concat "ADA_INCLUDE_PATH="
     (cons
      (concat "ADA_INCLUDE_PATH="

-            include
-            (mapconcat (lambda(x) (ada-get-absolute-dir x build-dir))
+            (mapconcat (lambda(x) (expand-file-name x build-dir))

                        (ada-xref-get-project-field 'src_dir)
                        (ada-xref-get-project-field 'src_dir)

-                       path-separator))
+                       path-separator)
+            include)

      (cons
       (concat "ADA_OBJECTS_PATH="
      (cons
       (concat "ADA_OBJECTS_PATH="

-             objects
-             (mapconcat (lambda(x) (ada-get-absolute-dir x build-dir))
+             (mapconcat (lambda(x) (expand-file-name x build-dir))

                         (ada-xref-get-project-field 'obj_dir)
                         (ada-xref-get-project-field 'obj_dir)

-                        path-separator))
+                        path-separator)
+             objects)

       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)


@@ -1058,19 +1088,26 @@ If ARG is not nil, ask for user confirmation."
        (process-environment (ada-set-environment))
        (compilation-scroll-output t))
 
        (process-environment (ada-set-environment))
        (compilation-scroll-output t))
 

-    (set 'compilation-search-path
-        (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir)
-                                   (ada-xref-get-project-field 'build_dir)))
+    (setq compilation-search-path (ada-xref-get-src-dir-field))

 
     ;;  If no project file was found, ask the user
     (unless cmd
 
     ;;  If no project file was found, ask the user
     (unless cmd

-      (setq cmd "" arg t))
+      (setq cmd '("") arg t))

 
 

-    (compile (ada-remote
-             (if (or ada-xref-confirm-compile arg)
-                 (read-from-minibuffer "enter command to compile: " cmd)
-               cmd)))
-  ))
+    ;;  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
+    ;;  and the output of the commands.  This doesn't work with cmdproxy.exe,
+    ;;  which gets confused by newline characters.
+    (if (not (string-match ".exe" shell-file-name))
+       (setq cmd (concat cmd "\n\n")))
+
+    (compile (ada-quote-cmd cmd))))

 
 (defun ada-compile-current (&optional arg prj-field)
   "Recompile the current file.
 
 (defun ada-compile-current (&optional arg prj-field)
   "Recompile the current file.


@@ -1083,20 +1120,27 @@ 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))

-    
-    (set 'compilation-search-path
-        (ada-get-absolute-dir-list (ada-xref-get-project-field 'src_dir)
-                                   (ada-xref-get-project-field 'build_dir)))
+
+    (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)))

 
     ;;  If no project file was found, ask the user
 
     ;;  If no project file was found, ask the user

-    (if cmd
-       (set 'cmd (concat cmd " " (ada-convert-file-name (buffer-file-name))))
-      (setq cmd "" arg t))
-    
-    (compile (ada-remote
-             (if (or ada-xref-confirm-compile arg)
-                 (read-from-minibuffer "enter command to compile: " cmd)
-               cmd)))))
+    (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,
+    ;;  which gets confused by newline characters.
+    (if (not (string-match ".exe" shell-file-name))
+       (setq cmd (concat cmd "\n\n")))
+
+    (compile (ada-quote-cmd cmd))))

 
 (defun ada-check-current (&optional arg)
   "Recompile the current file.
 
 (defun ada-check-current (&optional arg)
   "Recompile the current file.


@@ -1106,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)
 


@@ -1117,24 +1161,32 @@ if ARG is not-nil, asks for user confirmation."
   (let ((command (ada-xref-get-project-field 'run_cmd)))
 
     ;;  Guess the command if it wasn't specified
   (let ((command (ada-xref-get-project-field 'run_cmd)))
 
     ;;  Guess the command if it wasn't specified

-    (if (or (not command) (string= command ""))
-        (set 'command (file-name-sans-extension (buffer-name))))
+    (if (not command)
+        (set 'command (list (file-name-sans-extension (buffer-name)))))
+
+    ;; 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)
 
     ;; Ask for the arguments to the command if required
     (if (or ada-xref-confirm-compile arg)

-       (set 'command (read-from-minibuffer "Enter command to execute: " command)))
-
-    ;; Modify the command to run remotely
-    (setq command (ada-remote command))
+       (setq command (read-from-minibuffer "Enter command to execute: "
+                                           command)))

 
     ;; Run the command
     (save-excursion
       (set-buffer (get-buffer-create "*run*"))
       (set 'buffer-read-only nil)
 
     ;; Run the command
     (save-excursion
       (set-buffer (get-buffer-create "*run*"))
       (set 'buffer-read-only nil)

+

       (erase-buffer)
       (erase-buffer)

-      (goto-char (point-min))
-      (insert "\nRunning " command "\n\n")
-      (start-process "run" (current-buffer) shell-file-name "-c" command)
+      (start-process "run" (current-buffer) shell-file-name
+                    "-c" command)
+      (comint-mode)
+      ;;  Set these two variables to their default values, since otherwise
+      ;;  the output buffer is scrolled so that only the last output line
+      ;;  is visible at the top of the buffer.
+      (set (make-local-variable 'scroll-step) 0)
+      (set (make-local-variable 'scroll-conservatively) 0)

       )
     (display-buffer "*run*")
 
       )
     (display-buffer "*run*")
 


@@ -1143,53 +1195,113 @@ if ARG is not-nil, asks for user confirmation."
     (switch-to-buffer "*run*")
     ))
 
     (switch-to-buffer "*run*")
     ))
 

-
-(defun ada-gdb-application (&optional arg)
+(defun ada-gdb-application (&optional arg executable-name)

   "Start the debugger on the application.
   "Start the debugger on the application.

+EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the
+project file.

 If ARG is non-nil, ask the user to confirm the command."
   (interactive "P")
   (let ((buffer (current-buffer))
 If ARG is non-nil, ask the user to confirm the command."
   (interactive "P")
   (let ((buffer (current-buffer))

-        gdb-buffer
-       cmd)
+       cmd pre-cmd post-cmd)

     (ada-require-project-file)
     (ada-require-project-file)

-    (set 'cmd (ada-xref-get-project-field 'debug_cmd))
-    (let ((machine (ada-xref-get-project-field 'remote_machine)))
-      (if (and machine (not (string= machine "")))
-         (error "This feature is not supported yet for remote environments")))
+    (setq cmd   (if executable-name
+                   (concat ada-prj-default-debugger " " executable-name)
+                 (ada-xref-get-project-field 'debug_cmd))
+         pre-cmd  (ada-xref-get-project-field 'debug_pre_cmd)
+         post-cmd (ada-xref-get-project-field 'debug_post_cmd))

 
     ;;  If the command was not given in the project file, start a bare gdb
     (if (not cmd)
        (set 'cmd (concat ada-prj-default-debugger
                          " "
 
     ;;  If the command was not given in the project file, start a bare gdb
     (if (not cmd)
        (set 'cmd (concat ada-prj-default-debugger
                          " "

-                         (file-name-sans-extension (buffer-file-name)))))
+                         (or executable-name
+                             (file-name-sans-extension (buffer-file-name))))))
+
+    ;;  For gvd, add an extra switch so that the Emacs window is completly
+    ;;  swallowed inside the Gvd one
+    (if (and ada-tight-gvd-integration
+            (string-match "^[^ \t]*gvd" cmd))
+       ;;  Start a new frame, so that when gvd exists we do not kill Emacs
+       ;;  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
+       ;;  as well
+       (let ((frame (make-frame '((visibility . nil)))))
+         (set 'cmd (concat
+                    cmd " --editor-window="
+                    (cdr (assoc 'outer-window-id (frame-parameters frame)))))
+         (select-frame frame)))
+
+    ;;  Add a -fullname switch
+    ;;  Use the remote machine
+    (set 'cmd (ada-remote (concat cmd " -fullname ")))
+
+    ;;  Ask for confirmation if required

     (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)))
 

-    ;;  Set the variable gud-last-last-frame so that glide-debug can find
-    ;;  the name of the Ada file, and thus of the project file if needed.
-    (if ada-prj-prj-file
-       (set 'gud-last-last-frame (cons ada-prj-prj-file 1)))
-    
-    (if (and (string-match "jdb" (comint-arguments cmd 0 0))
-            (boundp 'jdb))
-       (funcall (symbol-function 'jdb) cmd)
-      (gdb cmd))
-
-    (set 'gdb-buffer (symbol-value 'gud-comint-buffer))
-    
-    ;;  Switch back to the source buffer
-    ;;  and Activate the debug part in the contextual menu
-    (switch-to-buffer buffer)
-
-    (if (functionp 'gud-make-debug-menu)
-       (funcall (symbol-function 'gud-make-debug-menu)))
-
-    ;;  Warning: on Emacs >= 20.3.8, same-window-regexps includes gud-*,
-    ;;  so the following call to display buffer will select the
-    ;;  buffer instead of displaying it in another window
-    ;;  This is why the second argument to display-buffer is 't'
-    (display-buffer gdb-buffer t)
-    ))
+    (let ((old-comint-exec (symbol-function 'comint-exec)))
+
+      ;;  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))
+      (if (not (equal pre-cmd ""))
+         (setq pre-cmd (concat pre-cmd ada-command-separator)))
+
+      (set 'post-cmd (mapconcat 'identity post-cmd "\n"))
+      (if post-cmd
+         (set 'post-cmd (concat post-cmd "\n")))
+
+
+      ;;  Temporarily replaces the definition of `comint-exec' so that we
+      ;;  can execute commands before running gdb.
+      ;;  FIXME: This is evil and not temporary !!!  -stef
+      (fset 'comint-exec
+           `(lambda (buffer name command startfile switches)
+              (let (compilation-buffer-name-function)
+                (save-excursion
+                  (set 'compilation-buffer-name-function
+                       (lambda(x) (buffer-name buffer)))
+                  (compile (ada-quote-cmd
+                            (concat ,pre-cmd
+                                    command " "
+                                    (mapconcat 'identity switches " "))))))
+              ))
+
+      ;;  Tight integration should force the tty mode
+      (if (and (string-match "gvd" (comint-arguments cmd 0 0))
+              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))
+
+      ;;  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)
+
+      ;;  Move to the end of the debugger buffer, so that it is automatically
+      ;;  scrolled from then on.
+      (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
+      ;;  is going to have some relevant information.
+      (if (or (not (string-match "gvd" (comint-arguments cmd 0 0)))
+             (string-match "--tty" cmd))
+         (split-window-vertically))
+      (switch-to-buffer buffer)
+      )))

 
 
 (defun ada-reread-prj-file (&optional filename)
 
 
 (defun ada-reread-prj-file (&optional filename)


@@ -1202,35 +1314,53 @@ automatically modifies the setup for all the Ada buffer that use this file."
   (if filename
       (ada-parse-prj-file filename)
     (ada-parse-prj-file (ada-prj-find-prj-file)))
   (if filename
       (ada-parse-prj-file filename)
     (ada-parse-prj-file (ada-prj-find-prj-file)))

-  )

 
 

+  ;; Reread the location of the standard runtime library
+  (ada-initialize-runtime-library
+   (or (ada-xref-get-project-field 'cross_prefix) ""))
+  )

 
 ;; ------ Private routines
 
 (defun ada-xref-current (file &optional ali-file-name)
   "Update the cross-references for FILE.
 
 ;; ------ Private routines
 
 (defun ada-xref-current (file &optional ali-file-name)
   "Update the cross-references for FILE.

-This in fact recompiles FILE to create ALI-FILE-NAME."
+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'."

   ;; 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)))

-  ;; read the project file
-  (ada-require-project-file)
-  (let* ((cmd (ada-xref-get-project-field 'comp_cmd))
-        (process-environment (ada-set-environment))
-        (compilation-scroll-output t)
-        (name      (ada-convert-file-name (buffer-file-name)))
-        (body-name (ada-get-body-name name)))

 
 

-    ;; Always recompile the body when we can
-    (set 'body-name (or body-name name))
+  (let* ((name      (ada-convert-file-name file))
+        (body-name (or (ada-get-body-name name) name)))

 
 

-    ;; prompt for command to execute
-    (set 'cmd (concat cmd " " body-name))
-    (compile (ada-remote
-             (if ada-xref-confirm-compile
-                 (read-from-minibuffer "enter command to compile: " cmd)
-               cmd)))))
+    ;; 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))
+           process)
+       (if body-visible
+           (set-buffer body-visible)
+         (find-file body-name))
+
+       ;; 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.
+       (ada-compile-current)
+       (setq process (get-buffer-process "*compilation*"))
+
+       (while (and process
+                   (not (equal (process-status process) 'exit)))
+         (sit-for 1))
+
+       ;; remove the buffer for the body if it wasn't there before
+       (unless body-visible
+         (kill-buffer (find-buffer-visiting body-name)))
+       ))
+    body-name))

 
 (defun ada-find-file-in-dir (file dir-list)
   "Search for FILE in DIR-LIST."
 
 (defun ada-find-file-in-dir (file dir-list)
   "Search for FILE in DIR-LIST."


@@ -1238,46 +1368,23 @@ This in fact recompiles FILE to create ALI-FILE-NAME."
     (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."
 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
-                       (append
-
-                        ;; Add ${build_dir} in front of the path
-                        (list (ada-xref-get-project-field 'build_dir))
-                        
-                        (ada-get-absolute-dir-list
-                         (ada-xref-get-project-field 'obj_dir)
-                         (ada-xref-get-project-field 'build_dir))
-
-                        ;; Add the standard runtime at the end
-                        ada-xref-runtime-library-ali-path)))
+  (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))

 
 (defun ada-find-src-file-in-dir (file)
 
 (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."
 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
-                       (append
-
-                        ;; Add ${build_dir} in front of the path
-                        (list (ada-xref-get-project-field 'build_dir))
-
-                        (ada-get-absolute-dir-list
-                         (ada-xref-get-project-field 'src_dir)
-                         (ada-xref-get-project-field 'build_dir))
-
-                        ;; Add the standard runtime at the end
-                        ada-xref-runtime-library-specs-path)))
-  
+  (ada-find-file-in-dir file (ada-xref-get-src-dir-field)))

 
 (defun ada-get-ali-file-name (file)
   "Create the ali file name for the ada-file FILE.
 
 (defun ada-get-ali-file-name (file)
   "Create the ali file name for the ada-file FILE.


@@ -1291,76 +1398,106 @@ 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

+  ;;
+  ;; 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
+  ;;      it indeed contains the definition for the separate entity by checking
+  ;;      the 'D' lines.  This is done repeatedly, in case the direct parent is
+  ;;      also a separate.

 
   (save-excursion
     (set-buffer (get-file-buffer file))
     (let ((short-ali-file-name
            (concat (file-name-sans-extension (file-name-nondirectory file))
                    ".ali"))
 
   (save-excursion
     (set-buffer (get-file-buffer file))
     (let ((short-ali-file-name
            (concat (file-name-sans-extension (file-name-nondirectory file))
                    ".ali"))

-          ali-file-name)
-      ;; First step
-      ;; we take the first possible completion
-      (setq ali-file-name (ada-find-ali-file-in-dir short-ali-file-name))
-
-      ;; If we have found the .ali file, but the source file was a spec
-      ;; with a non-standard name, search the .ali file for the body if any,
-      ;; since the xref information is more complete in that one
-      (unless ali-file-name
-         (if (not (string= (file-name-extension file) "ads"))
-             (let ((is-spec nil)
-                   (specs ada-spec-suffixes)
-                   body-ali)
-               (while specs
-                 (if (string-match (concat (regexp-quote (car specs)) "$")
-                                   file)
-                     (set 'is-spec t))
-                 (set 'specs (cdr specs)))
-
-               (if is-spec
-                   (set 'body-ali
-                        (ada-find-ali-file-in-dir
-                         (concat (file-name-sans-extension
-                                  (file-name-nondirectory
-                                   (ada-other-file-name)))
-                                 ".ali"))))
-                (if body-ali
-                    (set 'ali-file-name body-ali))))
-       
-        ;;  else we did not find the .ali file
-        ;;  Second chance: in case the files do not have standard names (such
-        ;;  as for instance file_s.ada and file_b.ada), try to go to the
-        ;;  other file and look for its ali file
-        (setq short-ali-file-name
-              (concat (file-name-sans-extension
-                      (file-name-nondirectory (ada-other-file-name)))
-                      ".ali"))
-        (setq ali-file-name (ada-find-ali-file-in-dir short-ali-file-name))
-       
-        ;; If still not found, try to recompile the file
-        (if (not ali-file-name)
-            (progn
-              ;; recompile only if the user asked for this
-              (if ada-xref-create-ali
-                  (ada-xref-current file ali-file-name))
-              (error "Ali file not found. Recompile your file")))
-        )
+          ali-file-name
+         is-spec)
+
+      ;; 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
+      ;; we can with the .ali file for the spec...
+
+      (if (not (string= (file-name-extension file) "ads"))
+         (let ((specs ada-spec-suffixes))
+           (while specs
+             (if (string-match (concat (regexp-quote (car specs)) "$")
+                               file)
+                 (set 'is-spec t))
+             (set 'specs (cdr specs)))))
+
+      (if is-spec
+         (set 'ali-file-name
+              (ada-find-ali-file-in-dir
+               (concat (file-name-sans-extension
+                        (file-name-nondirectory
+                         (ada-other-file-name)))
+                       ".ali"))))
+
+
+      (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 did not find the .ali file Second chance: in case
+               ;;  the files do not have standard names (such as for instance
+               ;;  file_s.ada and file_b.ada), try to go to the other file
+               ;;  and look for its ali file
+               (ada-find-ali-file-in-dir
+                (concat (file-name-sans-extension
+                         (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))))
+
+                 (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)))
+
+      ;; 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
+         ;; temporarily disabling the automatic compilation.
+
+         (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 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)
-          (ada-xref-current file ali-file-name))

 
 

-      ;; else returns the correct absolute file name
+       ;; 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)
+           (ada-xref-current file ali-file-name)))
+
+      ;;  Always return the correct absolute file name

       (expand-file-name ali-file-name))
       (expand-file-name ali-file-name))

-    ))
+      ))

 
 (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


@@ -1372,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)))


@@ -1380,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")))

 
       )))
 
 
       )))
 


@@ -1395,19 +1532,14 @@ file for possible paths."
     (count-lines begin (point))))
 
 (defun ada-read-identifier (pos)
     (count-lines begin (point))))
 
 (defun ada-read-identifier (pos)

-  "Returns the identlist around POS and switch to the .ali buffer."
-
-  ;; If there's a compilation in progress, it's probably because the
-  ;; .ali file didn't exist. So we should wait...
-  (if compilation-in-progress
-      (progn
-        (message "Compilation in progress. Try again when it is finished")
-        (set 'quit-flag t)))
+  "Returns the identlist around POS and switch to the .ali buffer.
+The returned list represents the entity, and can be manipulated through the
+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)


@@ -1444,12 +1576,12 @@ file for possible paths."
       (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))


@@ -1459,7 +1591,7 @@ file for possible paths."
 (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)


@@ -1469,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)


@@ -1479,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))
          ))


@@ -1488,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))


@@ -1498,21 +1630,25 @@ 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
           ;; is not required to have a 'unit_number|' item included.
           ;; Or maybe we are already on the declaration...
                                 nil t)
 
           ;; if we did not find it, it may be because the first reference
           ;; is not required to have a 'unit_number|' item included.
           ;; Or maybe we are already on the declaration...

-          (unless (re-search-forward (concat "^\\([a-zA-Z0-9_.\"]+[ *]\\)*"
-                                            (ada-line-of identlist)
-                                            "[^0-9]"
-                                            (ada-column-of identlist))
-                                    nil t)
-           
+          (unless (re-search-forward
+                  (concat
+                   "^[0-9]+.[0-9]+[ *]"
+                   (ada-name-of identlist)
+                   "[ <{=\(]\\(.\\|\n\\.\\)*\\<"
+                   (ada-line-of identlist)
+                   "[^0-9]"
+                   (ada-column-of identlist) "\\>")
+                  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


@@ -1529,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)


@@ -1547,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)


@@ -1563,11 +1699,20 @@ from the ali file (definition file and places where it is referenced)."
             )
 
          (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
             )
 
          (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)

-             (ada-set-declare-file
-              identlist
-              (ada-get-ada-file-name (match-string 1)
-                                     (ada-file-of identlist))))
-         
+
+             ;;  If we can find the file
+             (condition-case err
+                 (ada-set-declare-file
+                  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)))
+               ))
+

          (ada-set-references   identlist current-line)
          ))
   ))
          (ada-set-references   identlist current-line)
          ))
   ))


@@ -1593,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]+\\)[ *]")


@@ -1620,41 +1765,44 @@ 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
            ;; more than one => display choice list
            (t

-            (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 "  ---   ---------------------     ----  ----\n")
-              (let ((counter 1))
-                (while (<= counter len)
-                  (princ (format "  %2d)    %-21s   %4s  %4s\n"
-                                 counter
+           (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 "  ---   ---------------------     ----  ----\n")
+               (let ((counter 0))
+                 (while (< counter len)
+                   (princ (format "  %2d)    %-21s   %4s  %4s\n"
+                                 (1+ counter)

                                 (ada-get-ada-file-name
                                 (ada-get-ada-file-name

-                                 (nth 1 (nth (1- counter) declist))
+                                 (nth 1 (nth counter declist))

                                  (ada-file-of identlist))
                                  (ada-file-of identlist))

-                                 (nth 2 (nth (1- counter) declist))
-                                 (nth 3 (nth (1- counter) declist))
+                                 (nth 2 (nth counter declist))
+                                 (nth 3 (nth counter declist))

                                  ))
                                  ))

-                  (setq counter (1+ counter))
-                  ) ; end of while
-                ) ; end of let
-              ) ; end of with-output-to ...
-            (setq choice nil)
-            (while (or
-                    (not choice)
-                    (not (integerp choice))
-                    (< choice 1)
-                    (> choice len))
-              (setq choice (string-to-int
-                            (read-from-minibuffer "Enter No. of your choice: "))))
+                   (setq counter (1+ counter))
+                   ) ; end of while
+                 ) ; end of let
+               ) ; end of with-output-to ...
+             (setq choice nil)
+             (while (or
+                     (not choice)
+                     (not (integerp choice))
+                     (< choice 1)
+                     (> choice len))
+               (setq choice
+                     (string-to-int
+                      (read-from-minibuffer "Enter No. of your choice: "))))
+             )

            (set-buffer ali-buffer)
             (goto-line (car (nth (1- choice) declist)))
             ))))))
            (set-buffer ali-buffer)
             (goto-line (car (nth (1- choice) declist)))
             ))))))


@@ -1667,60 +1815,204 @@ opens a new window to show the declaration."
 
   (ada-get-all-references identlist)
   (let ((ali-line (ada-references-of identlist))
 
   (ada-get-all-references identlist)
   (let ((ali-line (ada-references-of identlist))

+       (locations nil)
+       (start 0)

        file  line  col)
        file  line  col)

-    
-    ;; If we were on a declaration, go to the body
-    (if (ada-on-declaration identlist)
-       (if (string-match "\\([0-9]+\\)[bc]\\([0-9]+\\)" ali-line)
-           (progn
-             (setq line (match-string 1 ali-line)
-                   col  (match-string 2 ali-line))
-             ;;  it there was a file number in the same line
-             (if (string-match "\\([0-9]+\\)|\\([^|bc]+\\)?[bc]" ali-line)
-                 (let ((file-number (match-string 1 ali-line)))
-                   (goto-char (point-min))
-                   (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t
-                                      (string-to-number file-number))
-                   (set 'file (match-string 1))
-                   )
-               ;; Else get the nearest file
-               (set 'file (ada-declare-file-of identlist))
-               )
-             )
-         (error "No body found"))
-    
-      ;; Else we were not on the declaration, find the place for it
-      (string-match "\\([0-9]+\\)[a-zA-Z+]\\([0-9]+\\)[ *]" ali-line)
-      (setq line (match-string 1 ali-line)
-           col  (match-string 2 ali-line)
-           file (ada-declare-file-of identlist))
-      )
+
+    ;; Note: in some cases, an entity can have multiple references to the
+    ;; bodies (this is for instance the case for a separate subprogram, that
+    ;; has a reference both to the stub and to the real body).
+    ;; In that case, we simply go to each one in turn.
+
+    ;; Get all the possible locations
+    (string-match "^\\([0-9]+\\)[a-zA-Z+]\\([0-9]+\\)[ *]" ali-line)
+    (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)
+      (setq line  (match-string 1 ali-line)
+           col   (match-string 3 ali-line)
+           start (match-end 3))
+
+      ;;  it there was a file number in the same line
+      (if (string-match (concat "[^{(<]\\([0-9]+\\)|\\([^|bc]+\\)?"
+                               (match-string 0 ali-line))
+                       ali-line)
+         (let ((file-number (match-string 1 ali-line)))
+           (goto-char (point-min))
+           (re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t
+                              (string-to-number file-number))
+           (set 'file (match-string 1))
+           )
+       ;; 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
+    ;; the specs
+    (set 'locations (append locations (list (car locations))))
+
+    ;; Find the new location we want to go to.
+    ;; If we are on none of the locations listed, we simply go to the specs.
+
+    (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))
+              (string= (file-name-nondirectory (nth 2 (car locations)))
+                       (file-name-nondirectory (ada-file-of identlist))))
+         (setq locations (cadr locations)
+               line      (car locations)
+               col       (nth 1 locations)
+               file      (nth 2 locations)
+               locations nil)
+       (set 'locations (cdr locations))))
+
+    ;;  Find the file in the source path
+    (set 'file (ada-get-ada-file-name file (ada-file-of identlist)))
+
+    ;; Kill the .ali buffer
+    (kill-buffer (current-buffer))

 
     ;; Now go to the buffer
 
     ;; Now go to the buffer

-    (ada-xref-change-buffer
-     (ada-get-ada-file-name file (ada-file-of identlist))
-     (string-to-number line)
-     (1- (string-to-number col))
-     identlist
-     other-frame)
+    (ada-xref-change-buffer file
+                           (string-to-number line)
+                           (1- (string-to-number col))
+                           identlist
+                           other-frame)

     ))
 
     ))
 

+(defun ada-find-in-src-path (identlist &optional other-frame)
+  "More general function for cross-references.
+This function should be used when the standard algorithm that parses the
+.ali file has failed, either because that file was too old or even did not
+exist.
+This function attempts to find the possible declarations for the identifier
+anywhere in the object path.
+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."
+
+  (let (list
+       (dirs (ada-xref-get-obj-dir-field))
+       (regexp (concat "[ *]" (ada-name-of identlist)))
+       line column
+       choice
+       file)
+
+    (save-excursion
+
+      ;;  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.
+
+      (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))
+      (while (re-search-forward regexp nil t)
+       (save-excursion
+         (beginning-of-line)
+         (if (not (= (char-after) ?X))
+             (progn
+               (looking-at "\\([0-9]+\\).\\([0-9]+\\)")
+               (setq line   (match-string 1)
+                     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))))))))
+
+      ;;  Current buffer is still "*grep*"
+      (kill-buffer "*grep*")
+      )
+
+    ;;  Now display the list of possible matches
+    (cond
+
+     ;;  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)))
+      (if file
+         (ada-xref-change-buffer file
+                                 (string-to-number (nth 1 (car list)))
+                                 (string-to-number (nth 2 (car list)))
+                                 identlist
+                                 other-frame)
+       (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*"
+
+         (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 "  ---   ---------------------     ----  ----\n")
+         (let ((counter 0))
+           (while (< counter (length list))
+             (princ (format "  %2d)    %-21s   %4s  %4s\n"
+                            (1+ counter)
+                            (nth 0 (nth counter list))
+                            (nth 1 (nth counter list))
+                            (nth 2 (nth counter list))
+                            ))
+             (setq counter (1+ counter))
+             )))
+       (setq choice nil)
+       (while (or (not choice)
+                  (not (integerp choice))
+                  (< choice 1)
+                  (> choice (length list)))
+         (setq choice
+               (string-to-int
+                (read-from-minibuffer "Enter No. of your choice: "))))
+       )
+      (set 'choice (1- choice))
+      (kill-buffer "*choice list*")
+
+      (set 'file (ada-find-src-file-in-dir (car (nth choice list))))
+      (if file
+         (ada-xref-change-buffer file
+                                 (string-to-number (nth 1 (nth choice list)))
+                                 (string-to-number (nth 2 (nth choice list)))
+                                 identlist
+                                 other-frame)
+       (error (concat (car (nth choice list)) " not found in src_dir")))
+      (message "This is only a (good) guess at the cross-reference.")
+      ))))
+

 (defun ada-xref-change-buffer
   (file line column identlist &optional other-frame)
 (defun ada-xref-change-buffer
   (file line column identlist &optional other-frame)

-  "Select and display FILE, at LINE and COLUMN. The new file is
-associated with the same project file as the one for IDENTLIST.
+  "Select and display FILE, at LINE and COLUMN.

 If we do not end on the same identifier as IDENTLIST, find the closest
 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."
 
 If OTHER-FRAME is non-nil, creates a new frame to show the file."
 

-  (let (prj-file
-        declaration-buffer
-       (ali-buffer (current-buffer)))
-
-    ;; get the current project file for the source ada file
-    (save-excursion
-      (set-buffer (get-file-buffer (ada-file-of identlist)))
-      (set 'prj-file ada-prj-prj-file))
+  (let (declaration-buffer)

 
     ;; Select and display the destination buffer
     (if ada-xref-other-buffer
 
     ;; Select and display the destination buffer
     (if ada-xref-other-buffer


@@ -1733,10 +2025,6 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file."
       (find-file file)
       )
 
       (find-file file)
       )
 

-    ;; If the new buffer is not already associated with a project file, do it
-    (unless (my-local-variable-if-set-p 'ada-prj-prj-file (current-buffer))
-      (set (make-local-variable 'ada-prj-prj-file) prj-file))
-

     ;; move the cursor to the correct position
     (push-mark)
     (goto-line line)
     ;; move the cursor to the correct position
     (push-mark)
     (goto-line line)


@@ -1747,8 +2035,7 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file."
     ;; this is probably the right one.
     (unless (looking-at (ada-name-of identlist))
       (ada-xref-search-nearest (ada-name-of identlist)))
     ;; this is probably the right one.
     (unless (looking-at (ada-name-of identlist))
       (ada-xref-search-nearest (ada-name-of identlist)))

-
-    (kill-buffer ali-buffer)))
+    ))

 
 
 (defun ada-xref-search-nearest (name)
 
 
 (defun ada-xref-search-nearest (name)


@@ -1875,13 +2162,28 @@ This function typically is to be hooked into `ff-file-created-hooks'."
 
   (save-some-buffers nil nil)
 
 
   (save-some-buffers nil nil)
 

-  (ada-require-project-file)
+  ;; If the current buffer is the body (as is the case when calling this
+  ;; function from ff-file-created-hooks), then kill this temporary buffer
+  (unless (interactive-p)
+    (progn
+      (set-buffer-modified-p nil)
+      (kill-buffer (current-buffer))))
+

 
 

-  (delete-region (point-min) (point-max))
+  ;;  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)
+
+  (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
+  ;;  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)

 
   ;; Call the external process gnatstub
   (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
 
   ;; Call the external process gnatstub
   (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))

-         (filename      (buffer-file-name (car (cdr (buffer-list)))))
+         (filename      (buffer-file-name (car (buffer-list))))

          (output        (concat (file-name-sans-extension filename) ".adb"))
          (gnatstub-cmd  (concat "gnatstub " gnatstub-opts " " filename))
          (buffer        (get-buffer-create "*gnatstub*")))
          (output        (concat (file-name-sans-extension filename) ".adb"))
          (gnatstub-cmd  (concat "gnatstub " gnatstub-opts " " filename))
          (buffer        (get-buffer-create "*gnatstub*")))


@@ -1908,10 +2210,6 @@ This function typically is to be hooked into `ff-file-created-hooks'."
 
       ;; Else clean up the output
 
 
       ;; Else clean up the output
 

-      ;;  Kill the temporary buffer created by find-file
-      (set-buffer-modified-p nil)
-      (kill-buffer (current-buffer))
-

       (if (file-exists-p output)
           (progn
             (find-file output)
       (if (file-exists-p output)
           (progn
             (find-file output)


@@ -1922,53 +2220,46 @@ This function typically is to be hooked into `ff-file-created-hooks'."
         )
       )))
 
         )
       )))
 

-

 (defun ada-xref-initialize ()
 (defun ada-xref-initialize ()

-  "Function called by ada-mode-hook to initialize the ada-xref.el package.
-For instance, it creates the gnat-specific menus, set some hooks for
+  "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...."
 find-file...."

-  (make-local-hook 'ff-file-created-hooks)
-  (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)
+  ;; This should really be an `add-hook'.  -stef
+  (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)

   )
 
 
 ;; ----- Add to ada-mode-hook ---------------------------------------------
 
   )
 
 
 ;; ----- Add to ada-mode-hook ---------------------------------------------
 

-;;  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)
+;;  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.
+;;  This must be done before initializing the Ada menu.
+(if (ada-find-file-in-dir "gvd" exec-path)
+    (set 'ada-prj-default-debugger "gvd ")
+  (if (ada-find-file-in-dir "gvd.exe" exec-path)
+     (set 'ada-prj-default-debugger "gvd ")
+  (if (ada-find-file-in-dir "ddd" exec-path)
+      (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))

 
 (add-hook 'ada-mode-hook 'ada-xref-initialize)
 
 
 (add-hook 'ada-mode-hook 'ada-xref-initialize)
 

-;;  Use ddd as the default debugger if it was found
-(if (ada-find-file-in-dir "ddd" exec-path)
-    (set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))
-

 ;;  Initializes the cross references to the runtime library
 ;;  Initializes the cross references to the runtime library

-(ada-initialize-runtime-library)
+(ada-initialize-runtime-library "")

 
 ;;  Add these standard directories to the search path
 
 ;;  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)
 

-;;; ada-xref.el ends here
\ No newline at end of file
+;;; arch-tag: 415a39fe-577b-4676-b3b1-6ff6db7ca24e
+;;; ada-xref.el ends here