rename old-ada dir

1 files changed, 2359 insertions, 0 deletions

diff --git a/old-ada/ada-xref.el b/old-ada/ada-xref.el
new file mode 100644
index 0000000..c9c923e
--- /dev/null
+++ b/old-ada/ada-xref.el
@@ -0,0 +1,2359 @@
+;; ada-xref.el --- for lookup and completion in Ada mode
+
+;; Copyright (C) 1994-2019 Free Software Foundation, Inc.
+
+;; Author: Markus Heritsch <[email protected]>
+;;      Rolf Ebert <[email protected]>
+;;      Emmanuel Briot <[email protected]>
+;; Maintainer: Stephen Leake <[email protected]>
+;; Keywords: languages ada xref
+;; Package: ada-mode
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; 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
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; 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.
+;;
+;; If a file *.`adp' exists in the ada-file directory, then it is
+;; read for configuration information.  It is read only the first
+;; time a cross-reference is asked for, and is not read later.
+
+;;; Code:
+
+;; ----- Requirements -----------------------------------------------------
+
+(require 'compile)
+(require 'comint)
+(require 'find-file)
+(require 'ada-mode)
+(eval-when-compile (require 'cl-lib))
+
+;; ------ User variables
+(defcustom ada-xref-other-buffer t
+  "If nil, always display the cross-references in the same buffer.
+Otherwise create either a new buffer or a new frame."
+  :type 'boolean :group 'ada)
+
+(defcustom ada-xref-create-ali nil
+  "If non-nil, run gcc whenever the cross-references are not up-to-date.
+If nil, the cross-reference mode never runs gcc."
+  :type 'boolean :group 'ada)
+
+(defcustom ada-xref-confirm-compile nil
+  "If non-nil, ask for confirmation before compiling or running the application."
+  :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."
+  :type 'string :group 'ada)
+
+(defcustom ada-gnat-cmd "gnat"
+  "Default GNAT project file parser.
+Will be run with args \"list -v -Pfile.gpr\".
+Default is standard GNAT distribution; alternate \"gnatpath\"
+is faster, available from Ada mode web site."
+  :type 'string :group 'ada)
+
+(defcustom ada-gnatls-args '("-v")
+  "Arguments to pass to `gnatls' to find location of the runtime.
+Typical use is to pass `--RTS=soft-floats' on some systems that support it.
+
+You can also add `-I-' if you do not want the current directory to be included.
+Otherwise, going from specs to bodies and back will first look for files in the
+current directory.  This only has an impact if you are not using project files,
+but only ADA_INCLUDE_PATH."
+  :type '(repeat string) :group 'ada)
+
+(defcustom ada-prj-default-comp-opt "-gnatq -gnatQ"
+  "Default compilation options."
+  :type 'string :group 'ada)
+
+(defcustom ada-prj-default-bind-opt ""
+  "Default binder options."
+  :type 'string :group 'ada)
+
+(defcustom ada-prj-default-link-opt ""
+  "Default linker options."
+  :type 'string :group 'ada)
+
+(defcustom ada-prj-default-gnatmake-opt "-g"
+  "Default options for `gnatmake'."
+  :type 'string :group 'ada)
+
+(defcustom ada-prj-default-gpr-file ""
+  "Default GNAT project file.
+If non-empty, this file is parsed to set the source and object directories for
+the Ada mode project."
+  :type 'string :group 'ada)
+
+(defcustom ada-prj-ada-project-path-sep
+  (cond ((boundp 'path-separator) path-separator) ; 20.3+
+	((memq system-type '(windows-nt ms-dos)) ";")
+	(t ":"))
+  "Default separator for ada_project_path project variable."
+  :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-check-cmd
+  (concat "${cross_prefix}gnatmake -u -c -gnatc ${gnatmake_opt} ${full_current}"
+	  " -cargs ${comp_opt}")
+  "Default command to be used to compile a single file.
+Emacs will substitute the current filename for ${full_current}, or add
+the filename at the end.  This is the same syntax as in the project file."
+  :type 'string :group 'ada)
+
+(defcustom ada-prj-default-comp-cmd
+  (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
+	  " ${comp_opt}")
+  "Default command to be used to compile a single file.
+Emacs will substitute the current filename for ${full_current}, or add
+the filename at the end.  This is the same syntax as in the project file."
+  :type 'string :group 'ada)
+
+(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
+  "Default name of the debugger."
+  :type 'string :group 'ada)
+
+(defcustom ada-prj-default-make-cmd
+  (concat "${cross_prefix}gnatmake -o ${main} ${main} ${gnatmake_opt} "
+	  "-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}")
+  "Default command to be used to compile the application.
+This is the same syntax as in the project file."
+  :type 'string :group 'ada)
+
+(defcustom ada-prj-default-project-file ""
+  "Name of the current project file.
+Emacs will not try to use the search algorithm to find the project file if
+this string is not empty.  It is set whenever a project file is found."
+  :type '(file :must-match t) :group 'ada)
+
+(defcustom ada-gnatstub-opts "-q -I${src_dir}"
+  "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)
+
+(defcustom ada-always-ask-project nil
+  "If nil, use default values when no project file was found.
+Otherwise, ask the user for the name of the project file to use."
+  :type 'boolean :group 'ada)
+
+(defconst ada-on-ms-windows (memq system-type '(windows-nt))
+  "True if we are running on Windows.")
+
+(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 grep -E 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.")
+
+(defconst ada-prj-file-extension ".adp"
+  "The extension used for project files.")
+
+(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-ali-path '()
+  "Directories where the ali for the standard library is found.
+This is used for cross-references.")
+
+(defvar ada-xref-pos-ring '()
+  "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 ada-on-ms-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'.")
+
+(defvar ada-operator-re
+  "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"
+  "Regexp to match for operators.")
+
+(defvar ada-xref-project-files '()
+  "Associative list of project files with properties.
+It has the format: (project project ...)
+A project has the format: (project-file . project-plist)
+\(See `apropos plist' for operations on property lists).
+See `ada-default-prj-properties' for the list of valid properties.
+The current project is retrieved with `ada-xref-current-project'.
+Properties are retrieved with `ada-xref-get-project-field', set with
+`ada-xref-set-project-field'.  If project properties are accessed with no
+project file, a (nil . default-properties) entry is created.")
+
+
+;; ----- 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)
+  "Read the ali file FILE into a new buffer, and return the buffer's name."
+  (find-file-noselect (ada-get-ali-file-name file)))
+
+
+;; -----------------------------------------------------------------------
+
+(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-find-executable (exec-name)
+  "Find the full path to the executable file EXEC-NAME.
+If not found, throw an error.
+On Windows systems, this will properly handle .exe extension as well."
+  (let ((result (or (ada-find-file-in-dir exec-name exec-path)
+		    (ada-find-file-in-dir (concat exec-name ".exe") exec-path))))
+    (if result
+	result
+      (error "`%s' not found in path" exec-name))))
+
+(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."
+  (let ((gnatls
+	 (condition-case nil
+	     ;; if gnatls not found, just give up (may not be using GNAT)
+	     (ada-find-executable (concat cross-prefix "gnatls"))
+	   (error nil))))
+    (if gnatls
+	(save-excursion
+	  (setq ada-xref-runtime-library-specs-path '()
+		ada-xref-runtime-library-ali-path   '())
+	  (set-buffer (get-buffer-create "*gnatls*"))
+	  (widen)
+	  (erase-buffer)
+	  ;;  Even if we get an error, delete the *gnatls* buffer
+	  (unwind-protect
+	      (let ((status (apply 'call-process gnatls (append '(nil t nil) ada-gnatls-args))))
+		(goto-char (point-min))
+
+		;; Since we didn't provide all the inputs gnatls expects, it returns status 4
+		(if (/= 4 status)
+		    (error (buffer-substring (point) (line-end-position))))
+
+		;;  Source path
+
+		(search-forward "Source Search Path:")
+		(forward-line 1)
+		(while (not (looking-at "^$"))
+		  (back-to-indentation)
+		  (add-to-list 'ada-xref-runtime-library-specs-path
+                               (if (looking-at "<Current_Directory>")
+                                   "."
+				 (buffer-substring-no-properties
+				  (point)
+				  (point-at-eol))))
+		  (forward-line 1))
+
+		;;  Object path
+
+		(search-forward "Object Search Path:")
+		(forward-line 1)
+		(while (not (looking-at "^$"))
+		  (back-to-indentation)
+		  (add-to-list 'ada-xref-runtime-library-ali-path
+                               (if (looking-at "<Current_Directory>")
+                                   "."
+				 (buffer-substring-no-properties
+				  (point)
+				  (point-at-eol))))
+		  (forward-line 1))
+		)
+	    (kill-buffer nil))))
+
+    (setq ada-xref-runtime-library-specs-path
+	 (reverse ada-xref-runtime-library-specs-path))
+    (setq ada-xref-runtime-library-ali-path
+	 (reverse ada-xref-runtime-library-ali-path))
+    ))
+
+(defun ada-gnat-parse-gpr (plist gpr-file)
+  "Set gpr_file, src_dir and obj_dir properties in PLIST by parsing GPR-FILE.
+Return new value of PLIST.
+GPR_FILE must be full path to file, normalized.
+src_dir, obj_dir will include compiler runtime.
+Assumes environment variable ADA_PROJECT_PATH is set properly."
+  (with-current-buffer (get-buffer-create "*gnatls*")
+    (erase-buffer)
+
+    ;; this can take a long time; let the user know what's up
+    (message "Parsing %s ..." gpr-file)
+
+    ;;  Even if we get an error, delete the *gnatls* buffer
+    (unwind-protect
+	(let* ((cross-prefix (plist-get plist 'cross_prefix))
+	       (gnat (concat cross-prefix ada-gnat-cmd))
+	       ;; Putting quotes around gpr-file confuses gnatpath on Lynx; not clear why
+	       (gpr-opt (concat "-P" gpr-file))
+	       (src-dir '())
+	       (obj-dir '())
+	       (status (call-process gnat nil t nil "list" "-v" gpr-opt)))
+	  (goto-char (point-min))
+
+	  (if (/= 0 status)
+	      (error (buffer-substring (point) (line-end-position))))
+
+	  ;;  Source path
+
+	  (search-forward "Source Search Path:")
+	  (forward-line 1) ; first directory in list
+	  (while (not (looking-at "^$")) ; terminate on blank line
+	    (back-to-indentation) ; skip whitespace
+	    (cl-pushnew (if (looking-at "<Current_Directory>")
+                            default-directory
+                          (expand-file-name
+                           (buffer-substring-no-properties
+                            (point) (line-end-position))))
+                        src-dir :test #'equal)
+	    (forward-line 1))
+
+	  ;;  Object path
+
+	  (search-forward "Object Search Path:")
+	  (forward-line 1)
+	  (while (not (looking-at "^$"))
+	    (back-to-indentation)
+	    (cl-pushnew (if (looking-at "<Current_Directory>")
+                            default-directory
+                          (expand-file-name
+                           (buffer-substring-no-properties
+                            (point) (line-end-position))))
+                        obj-dir :test #'equal)
+	    (forward-line 1))
+
+	  ;; Set properties
+	  (setq plist (plist-put plist 'gpr_file gpr-file))
+	  (setq plist (plist-put plist 'src_dir src-dir))
+	  (plist-put plist 'obj_dir obj-dir)
+	  )
+      (kill-buffer nil)
+      (message "Parsing %s ... done" gpr-file)
+      )
+    ))
+
+(defun ada-treat-cmd-string (cmd-string)
+  "Replace variable references ${var} in CMD-STRING with the appropriate value.
+Also replace standard environment variables $var.
+Assumes project exists.
+As a special case, ${current} is replaced with the name of the current
+file, minus extension but with directory, and ${full_current} is
+replaced by the name including the extension."
+
+  (while (string-match "\\(-[^-$IO]*[IO]\\)?\\${\\([^}]+\\)}" cmd-string)
+    (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
+	  (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 "%s" (concat "No project or environment variable " name " found"))))
+
+      (cond
+       ((null value)
+	(setq cmd-string (replace-match "" t t cmd-string)))
+       ((stringp value)
+	(setq cmd-string (replace-match value t t cmd-string)))
+       ((listp value)
+	(let ((prefix (match-string 1 cmd-string)))
+	  (setq cmd-string (replace-match
+			    (mapconcat (lambda(x) (concat prefix x)) value " ")
+			    t t cmd-string)))))
+      ))
+  (substitute-in-file-name cmd-string))
+
+
+(defun ada-xref-get-project-field (field)
+  "Extract the value of FIELD from the current project file.
+Project variables are substituted.
+
+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* ((project-plist (cdr (ada-xref-current-project)))
+	 (value (plist-get project-plist field)))
+
+    (cond
+     ((eq field 'gnatmake_opt)
+      (let ((gpr-file (plist-get project-plist 'gpr_file)))
+	(if (not (string= gpr-file ""))
+	    (setq value (concat "-P\"" gpr-file "\" " value)))))
+
+     ;; FIXME: check for src_dir, obj_dir here, rather than requiring user to do it
+     (t
+      nil))
+
+    ;; 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-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-set-project-field (field value)
+  "Set FIELD to VALUE in current project.  Assumes project exists."
+  ;; same algorithm to find project-plist as ada-xref-current-project
+  (let* ((file-name (ada-xref-current-project-file))
+	 (project-plist (cdr (assoc file-name ada-xref-project-files))))
+
+    (setq project-plist (plist-put project-plist field value))
+    (setcdr (assoc file-name ada-xref-project-files) project-plist)))
+
+(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 project files
+	   ,@(mapcar
+	      (lambda (x)
+		(let* ((name (or (car x) "<default>"))
+		       (command `(lambda ()
+				   "Select the current project file."
+				   (interactive)
+				   (ada-select-prj-file ,name))))
+		  (vector
+		   (file-name-nondirectory name)
+		   command
+		   :button (cons
+			    :toggle
+			    (equal ada-prj-default-project-file
+				   (car x))
+			    ))))
+
+	      (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."
+  ;; FIXME: doc arguments
+
+  ;; This function is not itself interactive, but it is called as part
+  ;; of the prompt of interactive functions, so we require a project
+  ;; file.
+  (ada-require-project-file)
+  (let (list
+	(dirs (ada-xref-get-src-dir-field)))
+
+    (while dirs
+      (if (file-directory-p (car dirs))
+	  (setq list (append list (file-name-all-completions string (car dirs)))))
+      (setq 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 FILENAME, from 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 "%s not found in src_dir" filename))))
+
+
+;; ----- Utilities -------------------------------------------------
+
+(defun ada-require-project-file ()
+  "If the current project does not exist, load or create a default one.
+Should only be called from interactive functions."
+  (if (string= "" ada-prj-default-project-file)
+      (ada-reread-prj-file (ada-prj-find-prj-file t))))
+
+(defun ada-xref-current-project-file ()
+  "Return the current project file name; never nil.
+Call `ada-require-project-file' first if a project must exist."
+  (if (not (string= "" ada-prj-default-project-file))
+      ada-prj-default-project-file
+    (ada-prj-find-prj-file t)))
+
+(defun ada-xref-current-project ()
+  "Return the current project.
+Call `ada-require-project-file' first to ensure a project exists."
+  (let ((file-name (ada-xref-current-project-file)))
+    (assoc file-name ada-xref-project-files)))
+
+(defun ada-show-current-project ()
+  "Display current project file name in message buffer."
+  (interactive)
+  (message (ada-xref-current-project-file)))
+
+(defun ada-show-current-main ()
+  "Display current main file name in message buffer."
+  (interactive)
+  (message "ada-mode main: %s" (ada-xref-get-project-field 'main)))
+
+(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))
+  (if (> (length ada-xref-pos-ring) ada-xref-pos-ring-max)
+      (setcdr (nthcdr (1- ada-xref-pos-ring-max) ada-xref-pos-ring) nil)))
+
+(defun ada-xref-goto-previous-reference ()
+  "Go to the previous cross-reference we were on."
+  (interactive)
+  (if ada-xref-pos-ring
+      (let ((pos (car ada-xref-pos-ring)))
+	(setq ada-xref-pos-ring (cdr ada-xref-pos-ring))
+	(find-file (car (cdr pos)))
+	(goto-char (car pos)))))
+
+(defun ada-set-default-project-file (file)
+  "Set FILE as the current project file."
+  (interactive "fProject file:")
+  (ada-parse-prj-file file)
+  (ada-select-prj-file file))
+
+;; ------ Handling the project file -----------------------------
+
+(defun ada-prj-find-prj-file (&optional no-user-question)
+  "Find the project file associated with the current buffer.
+If the buffer is not in Ada mode, or not associated with a file,
+return `ada-prj-default-project-file'.  Otherwise, search for a file with
+the same base name as the Ada file, but extension given by
+`ada-prj-file-extension' (default .adp).  If not found, search for *.adp
+in the current directory; if several are found, and NO-USER-QUESTION
+is non-nil, prompt the user to select one.  If none are found, return
+\"default.adp\"."
+
+  (let (selected)
+
+    (if (not (and (derived-mode-p 'ada-mode)
+		  buffer-file-name))
+
+	;;  Not in an Ada buffer, or current buffer not associated
+	;;  with a file (for instance an emerge buffer)
+	(setq selected nil)
+
+      ;;  other cases: use a more complex algorithm
+
+      (let* ((current-file (buffer-file-name))
+	     (first-choice (concat
+			    (file-name-sans-extension current-file)
+			    ada-prj-file-extension))
+	     (dir          (file-name-directory current-file))
+
+	     (prj-files    (directory-files
+			    dir t
+			    (concat ".*" (regexp-quote
+					  ada-prj-file-extension) "$")))
+	     (choice       nil))
+
+	(cond
+
+	 ((file-exists-p first-choice)
+	  ;; filename.adp
+	  (setq selected first-choice))
+
+	 ((= (length prj-files) 1)
+	  ;; Exactly one project file was found in the current directory
+	  (setq selected (car prj-files)))
+
+	 ((and (> (length prj-files) 1) (not no-user-question))
+	  ;;  multiple project files in current directory, ask the user
+	  (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-number
+			    (read-from-minibuffer "Enter No. of your choice: "))))
+	    (setq selected (nth (1- choice) prj-files))))
+
+	 ((= (length prj-files) 0)
+	  ;; No project file in the current directory; ask user
+	  (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 "")
+	      (setq selected ada-last-prj-file))))
+	 )))
+
+    (or selected "default.adp")
+    ))
+
+(defun ada-default-prj-properties ()
+  "Return the default project properties list with the current buffer as main."
+
+  (let ((file (buffer-file-name nil)))
+    (list
+     ;; variable name alphabetical order
+     'ada_project_path (or (getenv "ADA_PROJECT_PATH") "")
+     'ada_project_path_sep  ada-prj-ada-project-path-sep
+     'bind_opt        ada-prj-default-bind-opt
+     'build_dir       default-directory
+     'casing          (if (listp ada-case-exception-file)
+			  ada-case-exception-file
+			(list ada-case-exception-file))
+     'check_cmd       (list ada-prj-default-check-cmd) ;; FIXME: should not a list
+     'comp_cmd        (list ada-prj-default-comp-cmd) ;; FIXME: should not a list
+     'comp_opt        ada-prj-default-comp-opt
+     'cross_prefix    ""
+     'debug_cmd       (concat ada-prj-default-debugger
+			      " ${main}" (if ada-on-ms-windows ".exe")) ;; FIXME: don't need .exe?
+     'debug_post_cmd  (list nil)
+     'debug_pre_cmd   (list (concat ada-cd-command " ${build_dir}"))
+     'gnatmake_opt    ada-prj-default-gnatmake-opt
+     'gnatfind_opt    ada-prj-gnatfind-switches
+     'gpr_file        ada-prj-default-gpr-file
+     'link_opt        ada-prj-default-link-opt
+     'main            (if file
+			  (file-name-nondirectory
+			   (file-name-sans-extension file))
+			"")
+     'make_cmd        (list ada-prj-default-make-cmd) ;; FIXME: should not a list
+     'obj_dir         (list ".")
+     'remote_machine  ""
+     'run_cmd         (list (concat "./${main}" (if ada-on-ms-windows ".exe")))
+     ;; FIXME: should not a list
+     ;; FIXME: don't need .exe?
+     'src_dir         (list ".")
+     )))
+
+(defun ada-parse-prj-file (prj-file)
+  "Read PRJ-FILE, set project properties in `ada-xref-project-files'."
+  (let ((project (ada-default-prj-properties)))
+
+    (setq prj-file (expand-file-name prj-file))
+    (if (string= (file-name-extension prj-file) "gpr")
+	(setq project (ada-gnat-parse-gpr project prj-file))
+
+      (setq project (ada-parse-prj-file-1 prj-file project))
+      )
+
+    ;; Store the project properties
+    (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)))
+
+    (ada-xref-update-project-menu)
+    ))
+
+(defun ada-parse-prj-file-1 (prj-file project)
+  "Parse the Ada mode project file PRJ-FILE, set project properties in PROJECT.
+Return new value of PROJECT."
+  (let ((ada-buffer (current-buffer))
+	;; fields that are lists or otherwise require special processing
+	ada_project_path casing comp_cmd check_cmd
+	debug_pre_cmd debug_post_cmd gpr_file make_cmd obj_dir src_dir run_cmd)
+
+    ;; Give users a chance to use compiler-specific project file formats
+    (let ((buffer (run-hook-with-args-until-success
+		   'ada-load-project-hook prj-file)))
+      (unless buffer
+	;; we load the project file with no warnings; if it does not
+	;; exist, we stay in the Ada buffer; no project variable
+	;; settings will be found. That works for the default
+	;; "default.adp", which does not exist as a file.
+	(setq buffer (find-file-noselect prj-file nil)))
+      (set-buffer buffer))
+
+    (widen)
+    (goto-char (point-min))
+
+    ;; process each line
+    (while (not (eobp))
+
+      ;; ignore lines that don't have the format "name=value", put
+      ;; 'name', 'value' in match-string.
+      (if (looking-at "^\\([^=\n]+\\)=\\(.*\\)")
+	  (cond
+	   ;; FIXME: strip trailing spaces
+	   ;; variable name alphabetical order
+	   ((string= (match-string 1) "ada_project_path")
+	    (cl-pushnew (expand-file-name
+                         (substitute-in-file-name (match-string 2)))
+                        ada_project_path :test #'equal))
+
+	   ((string= (match-string 1) "build_dir")
+	    (setq project
+		 (plist-put project 'build_dir
+			    (file-name-as-directory (match-string 2)))))
+
+	   ((string= (match-string 1) "casing")
+	    (cl-pushnew (expand-file-name (substitute-in-file-name (match-string 2)))
+                        casing :test #'equal))
+
+	   ((string= (match-string 1) "check_cmd")
+	    (cl-pushnew (match-string 2) check_cmd :test #'equal))
+
+	   ((string= (match-string 1) "comp_cmd")
+	    (cl-pushnew (match-string 2) comp_cmd :test #'equal))
+
+	   ((string= (match-string 1) "debug_post_cmd")
+	    (cl-pushnew (match-string 2) debug_post_cmd :test #'equal))
+
+	   ((string= (match-string 1) "debug_pre_cmd")
+	    (cl-pushnew (match-string 2) debug_pre_cmd :test #'equal))
+
+	   ((string= (match-string 1) "gpr_file")
+	    ;; expand now; path is relative to Emacs project file
+	    (setq gpr_file (expand-file-name (match-string 2))))
+
+	   ((string= (match-string 1) "make_cmd")
+	    (cl-pushnew (match-string 2) make_cmd :test #'equal))
+
+	   ((string= (match-string 1) "obj_dir")
+	    (cl-pushnew (file-name-as-directory
+                         (expand-file-name (match-string 2)))
+                        obj_dir :test #'equal))
+
+	   ((string= (match-string 1) "run_cmd")
+	    (cl-pushnew (match-string 2) run_cmd :test #'equal))
+
+	   ((string= (match-string 1) "src_dir")
+	    (cl-pushnew (file-name-as-directory
+                         (expand-file-name (match-string 2)))
+                        src_dir :test #'equal))
+
+	   (t
+	    ;; any other field in the file is just copied
+	    (setq project (plist-put project
+				     (intern (match-string 1))
+				     (match-string 2))))))
+
+      (forward-line 1))
+
+    ;; done reading file
+
+    ;; back to the user buffer
+    (set-buffer ada-buffer)
+
+    ;; process accumulated lists
+    (if ada_project_path
+	(let ((sep (plist-get project 'ada_project_path_sep)))
+	  (setq ada_project_path (reverse ada_project_path))
+	  (setq ada_project_path (mapconcat 'identity ada_project_path sep))
+	  (setq project (plist-put project 'ada_project_path ada_project_path))
+	  ;; env var needed now for ada-gnat-parse-gpr
+	  (setenv "ADA_PROJECT_PATH" ada_project_path)))
+
+    (if debug_post_cmd (setq project (plist-put project 'debug_post_cmd (reverse debug_post_cmd))))
+    (if debug_pre_cmd (setq project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd))))
+    (if casing (setq project (plist-put project 'casing (reverse casing))))
+    (if check_cmd (setq project (plist-put project 'check_cmd (reverse check_cmd))))
+    (if comp_cmd (setq project (plist-put project 'comp_cmd (reverse comp_cmd))))
+    (if make_cmd (setq project (plist-put project 'make_cmd (reverse make_cmd))))
+    (if run_cmd (setq project (plist-put project 'run_cmd (reverse run_cmd))))
+
+    (if gpr_file
+	(progn
+	  (setq project (ada-gnat-parse-gpr project gpr_file))
+	  ;; append Ada source and object directories to others from Emacs project file
+	  (setq src_dir (append (plist-get project 'src_dir) src_dir))
+	  (setq obj_dir (append (plist-get project 'obj_dir) obj_dir))
+	  (setq ada-xref-runtime-library-specs-path '()
+		ada-xref-runtime-library-ali-path   '()))
+      )
+
+    ;; FIXME: gnatpath.exe doesn't output the runtime libraries, so always call ada-initialize-runtime-library
+    ;; if using a gpr_file, the runtime library directories are
+    ;; included in src_dir and obj_dir; otherwise they are in the
+    ;; 'runtime-library' variables.
+    ;; FIXME: always append to src_dir, obj_dir
+    (ada-initialize-runtime-library (or (ada-xref-get-project-field 'cross_prefix) ""))
+    ;;)
+
+    (if obj_dir (setq project (plist-put project 'obj_dir (reverse obj_dir))))
+    (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir))))
+
+    project
+    ))
+
+(defun ada-select-prj-file (file)
+  "Select FILE as the current project file."
+  (interactive)
+  (setq ada-prj-default-project-file (expand-file-name file))
+
+  (let ((casing (ada-xref-get-project-field 'casing)))
+    (if casing
+	(progn
+	  ;; FIXME: use ada-get-absolute-dir here
+	  (setq ada-case-exception-file casing)
+	  (ada-case-read-exceptions))))
+
+  (let ((ada_project_path (ada-xref-get-project-field 'ada_project_path)))
+    (if ada_project_path
+	;; FIXME: use ada-get-absolute-dir, mapconcat here
+	(setenv "ADA_PROJECT_PATH" ada_project_path)))
+
+  (setq compilation-search-path (ada-xref-get-src-dir-field))
+
+  (setq ada-search-directories-internal
+	;; FIXME: why do we need directory-file-name here?
+	(append (mapcar 'directory-file-name compilation-search-path)
+		ada-search-directories))
+
+  ;; return t, for decent display in message buffer when called interactively
+  t)
+
+(defun ada-find-references (&optional pos arg local-only)
+  "Find all references to the entity under POS.
+Calls gnatfind to find the references.
+If ARG is non-nil, the contents of the old *gnatfind* buffer is preserved.
+If LOCAL-ONLY is non-nil, only declarations in the current file are returned."
+  (interactive "d\nP")
+  (ada-require-project-file)
+
+  (let* ((identlist (ada-read-identifier pos))
+	 (alifile (ada-get-ali-file-name (ada-file-of identlist)))
+	 (process-environment (ada-set-environment)))
+
+    (set-buffer (get-file-buffer (ada-file-of identlist)))
+
+    ;;  if the file is more recent than the executable
+    (if (or (buffer-modified-p (current-buffer))
+	    (file-newer-than-file-p (ada-file-of identlist) alifile))
+	(ada-find-any-references (ada-name-of identlist)
+				 (ada-file-of identlist)
+				 nil nil local-only arg)
+      (ada-find-any-references (ada-name-of identlist)
+			       (ada-file-of identlist)
+			       (ada-line-of identlist)
+			       (ada-column-of identlist) local-only arg)))
+  )
+
+(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 non-nil, the contents of the old *gnatfind* buffer is preserved."
+  (interactive "d\nP")
+  (ada-find-references pos arg t))
+
+(defconst ada-gnatfind-buffer-name "*gnatfind*")
+
+(defun ada-find-any-references
+  (entity &optional file line column local-only append)
+  "Search for references to any entity whose name is ENTITY.
+ENTITY was first found the location given by FILE, LINE and COLUMN.
+If LOCAL-ONLY is non-nil, then list only the references in FILE,
+which is much faster.
+If APPEND is non-nil, then append the output of the command to the
+existing buffer `*gnatfind*', if there is one."
+  (interactive "sEntity name: ")
+  (ada-require-project-file)
+
+  ;;  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 ada-on-ms-windows
+		  (concat "\\\"" (substring entity 1 -1) "\\\"")
+		(concat "'\"" (substring entity 1 -1) "\"'"))
+	    entity))
+	 (switches (ada-xref-get-project-field 'gnatfind_opt))
+	 ;; FIXME: use gpr_file
+	 (cross-prefix (ada-xref-get-project-field 'cross_prefix))
+	 (command (concat cross-prefix "gnat find " switches " "
+			  quote-entity
+			  (if file (concat ":" (file-name-nondirectory file)))
+			  (if line (concat ":" line))
+			  (if column (concat ":" column))
+			  (if local-only (concat " " (file-name-nondirectory file)))
+			  ))
+	 old-contents)
+
+    ;;  If a project file is defined, use it
+    (if (and ada-prj-default-project-file
+	     (not (string= ada-prj-default-project-file "")))
+	(if (string-equal (file-name-extension ada-prj-default-project-file)
+			  "gpr")
+	    (setq command (concat command " -P\"" ada-prj-default-project-file "\""))
+	  (setq command (concat command " -p\"" ada-prj-default-project-file "\""))))
+
+    (if (and append (get-buffer ada-gnatfind-buffer-name))
+	(with-current-buffer "*gnatfind*"
+	  (setq old-contents (buffer-string))))
+
+    (let ((compilation-error "reference"))
+      (compilation-start command 'compilation-mode (lambda (_mode) ada-gnatfind-buffer-name)))
+
+    ;;  Hide the "Compilation" menu
+    (with-current-buffer ada-gnatfind-buffer-name
+      (local-unset-key [menu-bar compilation-menu])
+
+      (if old-contents
+	  (progn
+	    (goto-char 1)
+	    (setq buffer-read-only nil)
+	    (insert old-contents)
+	    (setq buffer-read-only t)
+	    (goto-char (point-max)))))
+    )
+  )
+
+(defalias 'ada-change-prj (symbol-function 'ada-set-default-project-file))
+
+;; ----- Identifier Completion --------------------------------------------
+(defun ada-complete-identifier (pos)
+  "Try to complete the identifier around POS, using compiler cross-reference information."
+  (interactive "d")
+  (ada-require-project-file)
+
+  ;; Initialize function-local variables and jump to the .ali buffer
+  ;; Note that for regexp search is case insensitive too
+  (let* ((curbuf (current-buffer))
+	 (identlist (ada-read-identifier pos))
+	 (sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\("
+			(regexp-quote (ada-name-of identlist))
+			"[a-zA-Z0-9_]*\\)"))
+	 (completed nil)
+	 (symalist nil))
+
+    ;; Open the .ali file
+    (set-buffer (ada-get-ali-buffer (buffer-file-name)))
+    (goto-char (point-max))
+
+    ;; build an alist of possible completions
+    (while (re-search-backward sofar nil t)
+      (setq symalist (cons (cons (match-string 1) nil) symalist)))
+
+    (setq completed  (try-completion "" symalist))
+
+    ;; kills .ali buffer
+    (kill-buffer nil)
+
+    ;; deletes the incomplete identifier in the buffer
+    (set-buffer curbuf)
+    (looking-at "[a-zA-Z0-9_]+")
+    (replace-match "")
+    ;; inserts the completed symbol
+    (insert completed)
+    ))
+
+;; ----- Cross-referencing ----------------------------------------
+
+(defun ada-point-and-xref ()
+  "Jump to the declaration of the entity below the cursor."
+  (interactive)
+  (mouse-set-point last-input-event)
+  (ada-goto-declaration (point)))
+
+(defun ada-point-and-xref-body ()
+  "Jump to the body of the entity under the cursor."
+  (interactive)
+  (mouse-set-point last-input-event)
+  (ada-goto-body (point)))
+
+(defun ada-goto-body (pos &optional other-frame)
+  "Display the body of the entity around POS.
+OTHER-FRAME non-nil means display in another frame.
+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
+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)
+
+  ;;  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 err
+	(ada-find-in-ali identlist other-frame)
+      ;; File not found: print explicit error message
+      (ada-error-file-not-found
+       (message "%s%s" (error-message-string err) (nthcdr 1 err)))
+
+      (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 declaration is shown in another frame if `ada-xref-other-buffer' is
+non-nil."
+  (interactive "d")
+  (ada-goto-declaration pos t))
+
+(defun ada-remote (command)
+  "Return the remote version of COMMAND, or COMMAND if remote_machine is nil."
+  (let ((machine (ada-xref-get-project-field 'remote_machine)))
+    (if (or (not machine) (string= machine ""))
+	command
+      (format "%s %s '(%s)'"
+	      remote-shell-program
+	      machine
+	      command))))
+
+(defun ada-get-absolute-dir-list (dir-list root-dir)
+  "Return the list of absolute directories found in DIR-LIST.
+If a directory is a relative directory, ROOT-DIR is prepended.
+Project and environment variables are substituted."
+  (mapcar (lambda (x) (expand-file-name x (ada-treat-cmd-string root-dir))) dir-list))
+
+(defun ada-set-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
+	(setq include (concat path-separator include)))
+    (if objects
+	(setq objects (concat path-separator objects)))
+    (cons
+     (concat "ADA_INCLUDE_PATH="
+	     (mapconcat (lambda(x) (expand-file-name x build-dir))
+			(ada-xref-get-project-field 'src_dir)
+			path-separator)
+	     include)
+     (cons
+      (concat "ADA_OBJECTS_PATH="
+	      (mapconcat (lambda(x) (expand-file-name x build-dir))
+			 (ada-xref-get-project-field 'obj_dir)
+			 path-separator)
+	      objects)
+      process-environment))))
+
+(defun ada-compile-application (&optional arg)
+  "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)
+  (let ((cmd (ada-xref-get-project-field 'make_cmd))
+	(process-environment (ada-set-environment))
+	(compilation-scroll-output t))
+
+    (setq compilation-search-path (ada-xref-get-src-dir-field))
+
+    ;;  If no project file was found, ask the user
+    (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 (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-set-main-compile-application ()
+  "Set main project variable to current buffer, build main."
+  (interactive)
+  (ada-require-project-file)
+  (let* ((file (buffer-file-name (current-buffer)))
+	 main)
+    (if (not file)
+	(error "No file for current buffer")
+
+      (setq main
+	    (if file
+		(file-name-nondirectory
+		 (file-name-sans-extension file))
+	      ""))
+      (ada-xref-set-project-field 'main main)
+      (ada-compile-application))))
+
+(defun ada-compile-current (&optional arg prj-field)
+  "Recompile the current file.
+If ARG is non-nil, ask for user confirmation of the command.
+PRJ-FIELD is the name of the field to use in the project file to get the
+command, and should be either `comp_cmd' (default) or `check_cmd'."
+  (interactive "P")
+  (ada-require-project-file)
+  (let* ((field (if prj-field prj-field 'comp_cmd))
+	 (cmd (ada-xref-get-project-field field))
+	 (process-environment (ada-set-environment))
+	 (compilation-scroll-output t))
+
+    (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 (or ada-xref-confirm-compile arg)
+	(setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
+
+    (compile (ada-quote-cmd cmd))))
+
+(defun ada-check-current (&optional arg)
+  "Check the current file for syntax errors.
+If ARG is non-nil, ask for user confirmation of the command."
+  (interactive "P")
+  (ada-compile-current arg 'check_cmd))
+
+(defun ada-run-application (&optional arg)
+  "Run the application.
+If ARG is non-nil, ask for user confirmation."
+  (interactive)
+  (ada-require-project-file)
+
+  (let ((machine (ada-xref-get-project-field 'cross_prefix)))
+    (if (and machine (not (string= machine "")))
+      (error "This feature is not supported yet for cross environments")))
+
+  (let ((command (ada-xref-get-project-field 'run_cmd)))
+
+    ;;  Guess the command if it wasn't specified
+    (if (not command)
+	(setq 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)
+	(setq command (read-from-minibuffer "Enter command to execute: "
+					    command)))
+
+    ;; Run the command
+    (with-current-buffer (get-buffer-create "*run*")
+      (setq buffer-read-only nil)
+
+      (erase-buffer)
+      (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*")
+
+    ;;  change to buffer *run* for interactive programs
+    (other-window 1)
+    (switch-to-buffer "*run*")
+    ))
+
+(defun ada-gdb-application (&optional arg executable-name)
+  "Start the debugger on the application.
+If ARG is non-nil, ask the user to confirm the command.
+EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the
+project file."
+  (interactive "P")
+  (ada-require-project-file)
+  (let ((buffer (current-buffer))
+	cmd pre-cmd post-cmd)
+    (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)
+	(setq cmd (concat ada-prj-default-debugger
+			  " "
+			  (or executable-name
+			      (file-name-sans-extension (buffer-file-name))))))
+
+    ;;  For gvd, add an extra switch so that the Emacs window is completely
+    ;;  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)))))
+	  (setq cmd (concat
+		     cmd " --editor-window="
+		     (cdr (assoc 'outer-window-id (frame-parameters frame)))))
+	  (select-frame frame)))
+
+    ;;  Add a -fullname switch
+    ;;  Use the remote machine
+    (setq cmd (ada-remote (concat cmd " -fullname ")))
+
+    ;;  Ask for confirmation if required
+    (if (or arg ada-xref-confirm-compile)
+	(setq cmd (read-from-minibuffer "enter command to debug: " cmd)))
+
+    (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))
+
+      (setq pre-cmd  (mapconcat 'identity pre-cmd  ada-command-separator))
+      (if (not (equal pre-cmd ""))
+	  (setq pre-cmd (concat pre-cmd ada-command-separator)))
+
+      (setq post-cmd (mapconcat 'identity post-cmd "\n"))
+      (if post-cmd
+	  (setq 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
+		   (setq 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.
+      (goto-char (point-max))
+
+      ;;  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-below))
+      (switch-to-buffer buffer)
+      )))
+
+(defun ada-reread-prj-file (&optional filename)
+  "Reread either the current project, or FILENAME if non-nil.
+If FILENAME is non-nil, set it as current project."
+  (interactive "P")
+  (if (not filename)
+    (setq filename ada-prj-default-project-file))
+  (ada-parse-prj-file filename)
+  (ada-select-prj-file filename))
+
+;; ------ 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 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)))
+
+  (let* ((name      (convert-standard-filename file))
+	 (body-name (or (ada-get-body-name name) name)))
+
+    ;; 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."
+  (let (found)
+    (while (and (not found) dir-list)
+      (setq found (concat (file-name-as-directory (car dir-list))
+			  (file-name-nondirectory file)))
+
+      (unless (file-exists-p found)
+	  (setq found nil))
+      (setq dir-list (cdr dir-list)))
+    found))
+
+(defun ada-find-ali-file-in-dir (file)
+  "Find the ali file FILE, searching obj_dir for the current project.
+Adds build_dir in front of the search path to conform to gnatmake's behavior,
+and the standard runtime location at the end."
+  (ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
+
+(defun ada-find-src-file-in-dir (file)
+  "Find the source file FILE, searching src_dir for the current project.
+Adds the standard runtime location at the end of the search path to conform
+to gnatmake's behavior."
+  (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.
+The file is searched for in every directory shown in the obj_dir lines of
+the project file."
+
+  ;; This function has to handle the special case of non-standard
+  ;; file names (i.e. not .adb or .ads)
+  ;; The trick is the following:
+  ;;   1- replace the extension of the current file with .ali,
+  ;;      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.
+  ;;   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 substituting 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.
+
+  (with-current-buffer (get-file-buffer file)
+    (let ((short-ali-file-name (concat (file-name-base file) ".ali"))
+	  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)
+		  (setq is-spec t))
+	      (setq specs (cdr specs)))))
+
+      (if is-spec
+	  (setq ali-file-name
+	       (ada-find-ali-file-in-dir
+		(concat (file-name-base (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-base (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-base file)))
+
+		  (while (and (not ali-file-name)
+			      (string-match "^\\(.*\\)[.-][^.-]*" parent-name))
+
+		    (setq parent-name (match-string 1 parent-name))
+		    (setq 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)))
+
+      ;;  Always return the correct absolute 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.
+The original file (where the user was) is ORIGINAL-FILE.
+Search in project file for possible paths."
+
+  (save-excursion
+
+    ;; If the buffer for original-file, use it to get the values from the
+    ;; project file, otherwise load the file and its project file
+    (let ((buffer (get-file-buffer original-file)))
+      (if buffer
+	  (set-buffer buffer)
+	(find-file original-file)))
+
+    ;; we choose the first possible completion and we
+    ;; return the absolute file name
+    (let ((filename (ada-find-src-file-in-dir file)))
+      (if filename
+	  (expand-file-name filename)
+	(signal 'ada-error-file-not-found (file-name-nondirectory file)))
+      )))
+
+(defun ada-find-file-number-in-ali (file)
+  "Return the file number for FILE in the associated ali file."
+  (set-buffer (ada-get-ali-buffer file))
+  (goto-char (point-min))
+
+  (let ((begin (re-search-forward "^D")))
+    (beginning-of-line)
+    (re-search-forward (concat "^D " (file-name-nondirectory file)))
+    (count-lines begin (point))))
+
+(defun ada-read-identifier (pos)
+  "Return 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"))
+
+  ;; goto first character of the identifier/operator (skip backward < and >
+  ;; since they are part of multiple character operators
+  (goto-char pos)
+  (skip-chars-backward "a-zA-Z0-9_<>")
+
+  ;; check if it really is an identifier
+  (if (ada-in-comment-p)
+      (error "Inside comment"))
+
+  (let (identifier identlist)
+    ;; Just in front of a string => we could have an operator declaration,
+    ;; as in "+", "-", ..
+    (if (= (char-after) ?\")
+	(forward-char 1))
+
+    ;; if looking at an operator
+    ;; This is only true if:
+    ;;   - the symbol is +, -, ...
+    ;;   - the symbol is made of letters, and not followed by _ or a letter
+    (if (and (looking-at ada-operator-re)
+	     (or (not (= (char-syntax (char-after)) ?w))
+		 (not (or (= (char-syntax (char-after (match-end 0))) ?w)
+			  (= (char-after (match-end 0)) ?_)))))
+	(progn
+	  (if (and (= (char-before) ?\")
+		   (= (char-after (+ (length (match-string 0)) (point))) ?\"))
+	      (forward-char -1))
+	  (setq identifier (regexp-quote (concat "\"" (match-string 0) "\""))))
+
+      (if (ada-in-string-p)
+	  (error "Inside string or character constant"))
+      (if (looking-at (concat ada-keywords "[^a-zA-Z_]"))
+	  (error "No cross-reference available for reserved keyword"))
+      (if (looking-at "[a-zA-Z0-9_]+")
+	  (setq identifier (match-string 0))
+	(error "No identifier around")))
+
+    ;; Build the identlist
+    (setq identlist    (ada-make-identlist))
+    (ada-set-name      identlist (downcase identifier))
+    (ada-set-line      identlist
+		       (number-to-string (count-lines 1 (point))))
+    (ada-set-column    identlist
+		       (number-to-string (1+ (current-column))))
+    (ada-set-file      identlist (buffer-file-name))
+    identlist
+    ))
+
+(defun ada-get-all-references (identlist)
+  "Complete IDENTLIST with definition file and places where it is referenced.
+Information is extracted from the ali file."
+
+  (let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist)))
+	declaration-found)
+    (set-buffer ali-buffer)
+    (goto-char (point-min))
+    (ada-set-on-declaration identlist nil)
+
+    ;; 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)
+	(let ((bound (save-excursion (re-search-forward "^X " nil t))))
+	  (setq declaration-found
+	       (re-search-forward
+		(concat "^"    (ada-line-of identlist)
+			"."    (ada-column-of identlist)
+			"[ *]" (ada-name-of identlist)
+			"[{[(<= ]?\\(.*\\)$") bound t))
+	  (if declaration-found
+	      (ada-set-on-declaration identlist t))
+	  ))
+
+    ;; If declaration is still nil, then we were not on a declaration, and
+    ;; have to fall back on other algorithms
+
+    (unless declaration-found
+
+      ;; Since we already know the number of the file, search for a direct
+      ;; reference to it
+      (goto-char (point-min))
+      (setq declaration-found t)
+      (ada-set-ali-index
+       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]+\\(\n\\.\\)? \\)*"
+					 (ada-line-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...
+	  (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
+	    (setq declaration-found nil)
+	    )
+	  )
+
+      ;; Last check to be completely sure we have found the correct line (the
+      ;; ali might not be up to date for instance)
+      (if declaration-found
+	  (progn
+	    (beginning-of-line)
+	    ;; while we have a continuation line, go up one line
+	    (while (looking-at "^\\.")
+	      (forward-line -1)
+	      (beginning-of-line))
+	    (unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
+					(ada-name-of identlist) "[ <{=([]"))
+	      (setq 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
+      ;; if the user does not want us to automatically recompile files
+      ;; automatically
+      (unless declaration-found
+	(if (ada-xref-find-in-modified-ali identlist)
+	    (setq declaration-found t)
+	  ;; No more idea to find the declaration.  Give up
+	  (progn
+	    (kill-buffer ali-buffer)
+
+	    (error "No declaration of %s found" (ada-name-of identlist))
+	    )))
+      )
+
+
+    ;; Now that we have found a suitable line in the .ali file, get the
+    ;; information available
+    (beginning-of-line)
+    (if declaration-found
+	(let ((current-line (buffer-substring
+			     (point) (point-at-eol))))
+	  (save-excursion
+	    (forward-line 1)
+	    (beginning-of-line)
+	    (while (looking-at "^\\.\\(.*\\)")
+	      (setq current-line (concat current-line (match-string 1)))
+	      (forward-line 1))
+	    )
+
+	  (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
+
+	      ;;  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
+		(ada-error-file-not-found
+		 (signal (car err) (cdr err)))
+		(error
+		 (kill-buffer ali-buffer)
+		 (error (error-message-string err)))
+		))
+
+	  (ada-set-references   identlist current-line)
+	  ))
+  ))
+
+(defun ada-xref-find-in-modified-ali (identlist)
+  "Find the matching position for IDENTLIST in the current ali buffer.
+This function is only called when the file was not up-to-date, so we need
+to make some guesses.
+This function is disabled for operators, and only works for identifiers."
+
+  (unless (= (string-to-char (ada-name-of identlist)) ?\")
+      (progn
+	(let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... ))
+	      (my-regexp  (concat "[ *]"
+				  (regexp-quote (ada-name-of identlist)) " "))
+	      (line-ada "--")
+	      (col-ada  "--")
+	      (line-ali 0)
+	      (len 0)
+	      (choice 0)
+	      (ali-buffer (current-buffer)))
+
+	  (goto-char (point-max))
+	  (while (re-search-backward my-regexp nil t)
+	    (save-excursion
+	      (setq 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]+\\)[ *]")
+		  (progn
+		    (setq line-ada (match-string 1))
+		    (setq col-ada  (match-string 2)))
+		(setq line-ada "--")
+		(setq col-ada  "--")
+		)
+	      ;; construct a list with the file names and the positions within
+	      (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t)
+		  (cl-pushnew (list line-ali (match-string 1) line-ada col-ada)
+                              declist :test #'equal)
+		)
+	      )
+	    )
+
+	  ;; how many possible declarations have we found ?
+	  (setq len (length declist))
+	  (cond
+	   ;; none => error
+	   ((= len 0)
+	    (kill-buffer (current-buffer))
+	    (error "No declaration of %s recorded in .ali file"
+		   (ada-name-of identlist)))
+	   ;; one => should be the right one
+	   ((= len 1)
+	    (goto-char (point-min))
+	    (forward-line (1- (caar declist))))
+
+	   ;; more than one => display choice list
+	   (t
+	    (save-window-excursion
+	      (with-output-to-temp-buffer "*choice list*"
+
+		(princ "Identifier is overloaded and Xref information is not up to date.\n")
+		(princ "Possible declarations are:\n\n")
+		(princ "  no.   in file                at line  col\n")
+		(princ "  ---   ---------------------     ----  ----\n")
+		(let ((counter 0))
+		  (while (< counter len)
+		    (princ (format "  %2d)    %-21s   %4s  %4s\n"
+				 (1+ counter)
+				 (ada-get-ada-file-name
+				  (nth 1 (nth counter declist))
+				  (ada-file-of identlist))
+				 (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-number
+		       (read-from-minibuffer "Enter No. of your choice: "))))
+	      )
+	    (set-buffer ali-buffer)
+	    (goto-char (point-min))
+	    (forward-line (1- (car (nth (1- choice) declist))))
+	    ))))))
+
+
+(defun ada-find-in-ali (identlist &optional other-frame)
+  "Look in the .ali file for the definition of the identifier in IDENTLIST.
+If OTHER-FRAME is non-nil, and `ada-xref-other-buffer' is non-nil,
+opens a new window to show the declaration."
+
+  (ada-get-all-references identlist)
+  (let ((ali-line (ada-references-of identlist))
+	(locations nil)
+	(start 0)
+	file  line  col)
+
+    ;; 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)
+    (setq 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
+      ;;  Make sure we correctly handle the case where the first file reference
+      ;;  on the line is the type reference.
+      ;;    1U2 T(2|2r3) 34r23
+      (if (string-match (concat "[^{(<0-9]\\([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))
+	    (setq file (match-string 1))
+	    )
+	;; Else get the nearest file
+	(setq file (ada-declare-file-of identlist)))
+
+      (setq 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
+    (setq 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)
+	(setq locations (cdr locations))))
+
+    ;;  Find the file in the source path
+    (setq file (ada-get-ada-file-name file (ada-file-of identlist)))
+
+    ;; Kill the .ali buffer
+    (kill-buffer (current-buffer))
+
+    ;; Now go to the buffer
+    (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 `grep' program to be available.
+
+This works well when one is using an external library and wants to find
+the declaration and documentation of the subprograms one is using."
+;; FIXME: what does this function do?
+  (let (list
+	(dirs (ada-xref-get-obj-dir-field))
+	(regexp (concat "[ *]" (ada-name-of identlist)))
+	line column
+	choice
+	file)
+
+    ;;  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.
+
+    (with-current-buffer (get-buffer-create "*grep*")
+      (while dirs
+	(insert (shell-command-to-string
+		 (concat
+		  "grep -E -i -h "
+		  (shell-quote-argument (concat "^X|" regexp "( |$)"))
+		  " "
+		  (shell-quote-argument (file-name-as-directory (car dirs)))
+		  "*.ali")))
+	(setq dirs (cdr dirs)))
+
+      ;;  Now parse the output
+      (setq 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]+ \\(.*\\)$")
+		(setq file (list (match-string 1) line column))
+
+		;;  There could be duplicate choices, because of the structure
+		;;  of the .ali files
+		(unless (member file list)
+		  (setq 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)
+      (setq 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 "%s not found in src_dir"  (caar list)))
+      (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-number
+		 (read-from-minibuffer "Enter No. of your choice: "))))
+	)
+      (setq choice (1- choice))
+      (kill-buffer "*choice list*")
+
+      (setq 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)
+	(signal 'ada-error-file-not-found (car (nth choice list))))
+      (message "This is only a (good) guess at the cross-reference.")
+      ))))
+
+(defun ada-xref-change-buffer
+  (file line column identlist &optional other-frame)
+  "Select and display FILE, at LINE and COLUMN.
+If we do not end on the same identifier as IDENTLIST, find the
+closest match.  Kills the .ali buffer at the end.
+If OTHER-FRAME is non-nil, creates a new frame to show the file."
+
+  (let (declaration-buffer)
+
+    ;; Select and display the destination buffer
+    (if ada-xref-other-buffer
+	(if other-frame
+	    (find-file-other-frame file)
+	  (setq declaration-buffer (find-file-noselect file))
+	  (set-buffer declaration-buffer)
+	  (switch-to-buffer-other-window declaration-buffer)
+	  )
+      (find-file file)
+      )
+
+    ;; move the cursor to the correct position
+    (push-mark)
+    (goto-char (point-min))
+    (forward-line (1- line))
+    (move-to-column column)
+
+    ;; If we are not on the identifier, the ali file was not up-to-date.
+    ;; Try to find the nearest position where the identifier is found,
+    ;; this is probably the right one.
+    (unless (looking-at (ada-name-of identlist))
+      (ada-xref-search-nearest (ada-name-of identlist)))
+    ))
+
+
+(defun ada-xref-search-nearest (name)
+  "Search for NAME nearest to the position recorded in the Xref file.
+Return the position of the declaration in the buffer, or nil if not found."
+  (let ((orgpos (point))
+	(newpos nil)
+	(diff nil))
+
+    (goto-char (point-max))
+
+    ;; loop - look for all declarations of name in this file
+    (while (search-backward name nil t)
+
+      ;; check if it really is a complete Ada identifier
+      (if (and
+	   (not (save-excursion
+		  (goto-char (match-end 0))
+		  (looking-at "_")))
+	   (not (ada-in-string-or-comment-p))
+	   (or
+	    ;; variable declaration ?
+	    (save-excursion
+	      (skip-chars-forward "a-zA-Z_0-9" )
+	      (ada-goto-next-non-ws)
+	      (looking-at ":[^=]"))
+	    ;; procedure, function, task or package declaration ?
+	    (save-excursion
+	      (ada-goto-previous-word)
+	      (looking-at "\\<[pP][rR][oO][cC][eE][dD][uU][rR][eE]\\>\\|\\<[fF][uU][nN][cC][tT][iI][oO][nN]\\>\\|\\<[tT][yY][pP][eE]\\>\\|\\<[tT][aA][sS][kK]\\>\\|\\<[pP][aA][cC][kK][aA][gG][eE]\\>\\|\\<[bB][oO][dD][yY]\\>"))))
+
+	  ;; check if it is nearer than the ones before if any
+	  (if (or (not diff)
+		  (< (abs (- (point) orgpos)) diff))
+	      (progn
+		(setq newpos (point)
+		      diff (abs (- newpos orgpos))))))
+      )
+
+    (if newpos
+	(progn
+	  (message "ATTENTION: this declaration is only a (good) guess ...")
+	  (goto-char newpos))
+      nil)))
+
+
+;; Find the parent library file of the current file
+(defun ada-goto-parent ()
+  "Go to the parent library file."
+  (interactive)
+  (ada-require-project-file)
+
+  (let ((buffer (ada-get-ali-buffer (buffer-file-name)))
+	(unit-name nil)
+	(body-name nil)
+	(ali-name nil))
+    (with-current-buffer buffer
+      (goto-char (point-min))
+      (re-search-forward "^U \\([^ \t%]+\\)%[bs][ \t]+\\([^ \t]+\\)")
+      (setq unit-name (match-string 1))
+      (if (not (string-match "\\(.*\\)\\.[^.]+" unit-name))
+	  (progn
+	    (kill-buffer buffer)
+	    (error "No parent unit !"))
+	(setq unit-name (match-string 1 unit-name))
+	)
+
+      ;; look for the file name for the parent unit specification
+      (goto-char (point-min))
+      (re-search-forward (concat "^W " unit-name
+				 "%s[ \t]+\\([^ \t]+\\)[ \t]+"
+				 "\\([^ \t\n]+\\)"))
+      (setq body-name (match-string 1))
+      (setq ali-name (match-string 2))
+      (kill-buffer buffer)
+      )
+
+    (setq ali-name (ada-find-ali-file-in-dir ali-name))
+
+    (save-excursion
+      ;; Tries to open the new ali file to find the spec file
+      (if ali-name
+	  (progn
+	    (find-file ali-name)
+	    (goto-char (point-min))
+	    (re-search-forward (concat "^U " unit-name "%s[ \t]+"
+				       "\\([^ \t]+\\)"))
+	    (setq body-name (match-string 1))
+	    (kill-buffer (current-buffer))
+	    )
+	)
+      )
+
+    (find-file body-name)
+    ))
+
+(defun ada-make-filename-from-adaname (adaname)
+  "Determine the filename in which ADANAME is found.
+This is a GNAT specific function that uses gnatkrunch."
+  (let ((krunch-buf (generate-new-buffer "*gkrunch*"))
+        (cross-prefix (plist-get (cdr (ada-xref-current-project)) 'cross_prefix)))
+    (with-current-buffer krunch-buf
+      ;; send adaname to external process `gnatkr'.
+      ;; Add a dummy extension, since gnatkr versions have two different
+      ;; behaviors depending on the version:
+      ;;   Up to 3.15:   "AA.BB.CC"  =>  aa-bb-cc
+      ;;   After:        "AA.BB.CC"  =>  aa-bb.cc
+      (call-process (concat cross-prefix "gnatkr") nil krunch-buf nil
+		    (concat adaname ".adb") ada-krunch-args)
+      ;; fetch output of that process
+      (setq adaname (buffer-substring
+		     (point-min)
+		     (progn
+		       (goto-char (point-min))
+		       (end-of-line)
+		       (point))))
+      ;;  Remove the extra extension we added above
+      (setq adaname (substring adaname 0 -4))
+
+      (kill-buffer krunch-buf)))
+  adaname
+  )
+
+(defun ada-make-body-gnatstub (&optional interactive)
+  "Create an Ada package body in the current buffer.
+This function uses the `gnat stub' program to create the body.
+This function typically is to be hooked into `ff-file-created-hook'.
+If INTERACTIVE is nil, assume this is called from `ff-file-created-hook'."
+  (interactive "p")
+  (ada-require-project-file)
+
+  ;; If not interactive, assume we are being called from
+  ;; ff-file-created-hook. Then the current buffer is for the body
+  ;; file, but we will create a new one after gnat stub runs
+  (unless interactive
+    (set-buffer-modified-p nil)
+    (kill-buffer (current-buffer)))
+
+  (save-some-buffers nil nil)
+
+  ;; Make sure the current buffer is the spec, so gnat stub gets the
+  ;; right package parameter (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))))
+
+  ;; Call the external process
+  (let* ((project-plist (cdr (ada-xref-current-project)))
+	 (gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
+	 (gpr-file (plist-get project-plist 'gpr_file))
+	 (filename      (buffer-file-name (car (buffer-list))))
+	 (output        (concat (file-name-sans-extension filename) ".adb"))
+	 (cross-prefix (plist-get project-plist 'cross_prefix))
+	 (gnatstub-cmd  (concat cross-prefix "gnat stub"
+				(if (not (string= gpr-file ""))
+				    (concat " -P\"" gpr-file "\""))
+				" " gnatstub-opts " " filename))
+	 (buffer        (get-buffer-create "*gnat stub*")))
+
+    (with-current-buffer buffer
+      (compilation-minor-mode 1)
+      (erase-buffer)
+      (insert gnatstub-cmd)
+      (newline)
+      )
+
+    (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd)
+
+    ;; clean up the output
+
+    (if (file-exists-p output)
+	(progn
+	  (find-file output)
+	  (kill-buffer buffer))
+
+      ;; file not created; display the error message
+      (display-buffer buffer))))
+
+(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, sets some hooks for
+`find-file'."
+  (remove-hook 'ff-file-created-hook 'ada-make-body) ; from global hook
+  (remove-hook 'ff-file-created-hook 'ada-make-body t) ; from local hook
+  (add-hook 'ff-file-created-hook 'ada-make-body-gnatstub nil t)
+
+  ;; 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 ---------------------------------------------
+
+;;  This must be done before initializing the Ada menu.
+(add-hook 'ada-mode-hook 'ada-xref-initialize)
+
+;;  Define a new error type
+(define-error 'ada-error-file-not-found
+  "File not found in src-dir (check project file): " 'ada-mode-errors)
+
+(provide 'ada-xref)
+
+;;; ada-xref.el ends here