Fix bug #272, and update Ada mode to version 4.0.

4 files changed, 561 insertions, 463 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 33acb5ad16d..df9eb674dd4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,29 @@
+2008-07-28  Stephen Leake  <stephen_leake@stephe-leake.org>
+
+	* progmodes/ada-mode.el (ada-mode): Clean up XEmacs handling.
+	Add support for add-log.
+	(ada-end-stmt-re): Fix bug - allow comment after 'when'.
+
+	* progmodes/ada-prj.el: Delete 'main_unit' project variable.
+	(ada-prj-save): Prompt for file name if not given.
+	(ada-prj-display-page): Display casing exceptions.
+
+	* progmodes/ada-xref.el: Add support for GNAT project files as Emacs
+	Ada mode project files.  Delete 'main_unit' project variable;
+	only need 'main'.  Simplify handling of default project values.
+	Use cross-prefix consistently.
+	(ada-find-executable): Throw error if not found.
+	(ada-initialize-runtime-library): Improve error handling when
+	gnatls not found.
+	(ada-gnat-parse-gpr): New.
+	(ada-treat-cmd-string): Allow process environment variables.
+	(ada-xref-set-default-prj-values): Delete; replace with
+	ada-default-prj-properties.
+	(ada-parse-prj-file): Handle GNAT project files.
+	(ada-parse-prj-file-1): New, factored out of ada-parse-prj-file.
+	(ada-select-prj-file): New.
+	(ada-get-absolute-dir-list): Allow project and environment variables.
+
 2008-07-27  Michael Albinus  <michael.albinus@gmx.de>
 
 	Sync with Tramp 2.1.14.
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 663f13965d1..0d619258ec5 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -135,7 +135,7 @@
 (defun ada-mode-version ()
   "Return Ada mode version."
   (interactive)
-  (let ((version-string "3.7"))
+  (let ((version-string "4.00"))
     (if (interactive-p)
 	(message version-string)
       version-string)))
@@ -636,6 +636,7 @@ The package name is in (match-string 4).")
     (concat "\\("
 	    ";"                                        "\\|"
 	    "=>[ \t]*$"                                "\\|"
+	    "=>[ \t]*--.*$"                            "\\|"
 	    "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)"  "\\|"
 	    "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
 				"loop" "private" "record" "select"
@@ -790,13 +791,13 @@ the 4 file locations can be clicked on and jumped to."
 
       ;; set source marker
       (save-excursion
-        (compilation-find-file (point-marker) (match-string 1) "./")
-        (set-buffer file)
+	(compilation-find-file (point-marker) (match-string 1) "./")
+	(set-buffer file)
 
-        (if (stringp line)
-            (goto-line (string-to-number line)))
+	(if (stringp line)
+	    (goto-line (string-to-number line)))
 
-        (setq source (point-marker)))
+	(setq source (point-marker)))
 
       (compilation-goto-locus error-pos source nil)
 
@@ -935,8 +936,7 @@ are treated as numbers instead of gnatprep comments."
 	(buffer-undo-list t)
 	(inhibit-read-only t)
 	(inhibit-point-motion-hooks t)
-	(inhibit-modification-hooks t)
-	buffer-file-name buffer-file-truename)
+	(inhibit-modification-hooks t))
     (remove-text-properties (point-min) (point-max) '(syntax-table nil))
     (goto-char (point-min))
     (while (re-search-forward
@@ -1197,9 +1197,6 @@ If you use ada-xref.el:
   (set (make-local-variable 'fill-paragraph-function)
        'ada-fill-comment-paragraph)
 
-  (set (make-local-variable 'imenu-generic-expression)
-       ada-imenu-generic-expression)
-
   ;;  Support for compile.el
   ;;  We just substitute our own functions to go to the error.
   (add-hook 'compilation-mode-hook
@@ -1214,23 +1211,13 @@ If you use ada-xref.el:
 		'ada-compile-goto-error)))
 
   ;;  font-lock support :
-  ;;  We need to set some properties for XEmacs, and define some variables
-  ;;  for Emacs
 
-  ;; FIXME: The Emacs code should work just fine under XEmacs AFAIK.  --Stef
-  (if (featurep 'xemacs)
-      ;;  XEmacs
-      (put 'ada-mode 'font-lock-defaults
-	   '(ada-font-lock-keywords
-	     nil t ((?\_ . "w") (?# . ".")) beginning-of-line))
-    ;;  Emacs
-    (set (make-local-variable 'font-lock-defaults)
-	 '(ada-font-lock-keywords
-	   nil t
-	   ((?\_ . "w") (?# . "."))
-	   beginning-of-line
-	   (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
-    )
+  (set (make-local-variable 'font-lock-defaults)
+       '(ada-font-lock-keywords
+	 nil t
+	 ((?\_ . "w") (?# . "."))
+	 beginning-of-line
+	 (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
 
   ;; Set up support for find-file.el.
   (set (make-local-variable 'ff-other-file-alist)
@@ -1243,34 +1230,34 @@ If you use ada-xref.el:
 
   (make-local-variable 'ff-special-constructs)
   (mapc (lambda (pair) (add-to-list 'ff-special-constructs pair))
-        (list
-         ;; Top level child package declaration; go to the parent package.
-         (cons (eval-when-compile
-                 (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
-                         "\\(body[ \t]+\\)?"
-                         "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
-               (lambda ()
-                 (ff-get-file
-                  ada-search-directories-internal
-                  (ada-make-filename-from-adaname (match-string 3))
-                  ada-spec-suffixes)))
-
-         ;; A "separate" clause.
-         (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
-               (lambda ()
-                 (ff-get-file
-                  ada-search-directories-internal
-                  (ada-make-filename-from-adaname (match-string 1))
-                  ada-spec-suffixes)))
-
-         ;; A "with" clause.
-         (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
-               (lambda ()
-                 (ff-get-file
-                  ada-search-directories-internal
-                  (ada-make-filename-from-adaname (match-string 1))
-                  ada-spec-suffixes)))
-         ))
+	(list
+	 ;; Top level child package declaration; go to the parent package.
+	 (cons (eval-when-compile
+		 (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
+			 "\\(body[ \t]+\\)?"
+			 "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
+	       (lambda ()
+		 (ff-get-file
+		  ada-search-directories-internal
+		  (ada-make-filename-from-adaname (match-string 3))
+		  ada-spec-suffixes)))
+
+	 ;; A "separate" clause.
+	 (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
+	       (lambda ()
+		 (ff-get-file
+		  ada-search-directories-internal
+		  (ada-make-filename-from-adaname (match-string 1))
+		  ada-spec-suffixes)))
+
+	 ;; A "with" clause.
+	 (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
+	       (lambda ()
+		 (ff-get-file
+		  ada-search-directories-internal
+		  (ada-make-filename-from-adaname (match-string 1))
+		  ada-spec-suffixes)))
+	 ))
 
   ;;  Support for outline-minor-mode
   (set (make-local-variable 'outline-regexp)
@@ -1278,6 +1265,8 @@ If you use ada-xref.el:
   (set (make-local-variable 'outline-level) 'ada-outline-level)
 
   ;;  Support for imenu : We want a sorted index
+  (setq imenu-generic-expression ada-imenu-generic-expression)
+
   (setq imenu-sort-function 'imenu--sort-by-name)
 
   ;;  Support for ispell : Check only comments
@@ -1290,40 +1279,40 @@ If you use ada-xref.el:
 
   ;; Exclude comments alone on line from alignment.
   (add-to-list 'align-exclude-rules-list
-               '(ada-solo-comment
-                 (regexp  . "^\\(\\s-*\\)--")
-                 (modes   . '(ada-mode))))
+	       '(ada-solo-comment
+		 (regexp  . "^\\(\\s-*\\)--")
+		 (modes   . '(ada-mode))))
   (add-to-list 'align-exclude-rules-list
-               '(ada-solo-use
-                 (regexp  . "^\\(\\s-*\\)\\<use\\>")
-                 (modes   . '(ada-mode))))
+	       '(ada-solo-use
+		 (regexp  . "^\\(\\s-*\\)\\<use\\>")
+		 (modes   . '(ada-mode))))
 
   (setq ada-align-modes nil)
 
   (add-to-list 'ada-align-modes
-               '(ada-declaration-assign
-                 (regexp  . "[^:]\\(\\s-*\\):[^:]")
-                 (valid   . (lambda() (not (ada-in-comment-p))))
-                 (repeat . t)
-                 (modes   . '(ada-mode))))
+	       '(ada-declaration-assign
+		 (regexp  . "[^:]\\(\\s-*\\):[^:]")
+		 (valid   . (lambda() (not (ada-in-comment-p))))
+		 (repeat . t)
+		 (modes   . '(ada-mode))))
   (add-to-list 'ada-align-modes
-               '(ada-associate
-                 (regexp  . "[^=]\\(\\s-*\\)=>")
-                 (valid   . (lambda() (not (ada-in-comment-p))))
-                 (modes   . '(ada-mode))))
+	       '(ada-associate
+		 (regexp  . "[^=]\\(\\s-*\\)=>")
+		 (valid   . (lambda() (not (ada-in-comment-p))))
+		 (modes   . '(ada-mode))))
   (add-to-list 'ada-align-modes
-               '(ada-comment
-                 (regexp  . "\\(\\s-*\\)--")
-                 (modes   . '(ada-mode))))
+	       '(ada-comment
+		 (regexp  . "\\(\\s-*\\)--")
+		 (modes   . '(ada-mode))))
   (add-to-list 'ada-align-modes
-               '(ada-use
-                 (regexp  . "\\(\\s-*\\)\\<use\\s-")
-                 (valid   . (lambda() (not (ada-in-comment-p))))
-                 (modes   . '(ada-mode))))
+	       '(ada-use
+		 (regexp  . "\\(\\s-*\\)\\<use\\s-")
+		 (valid   . (lambda() (not (ada-in-comment-p))))
+		 (modes   . '(ada-mode))))
   (add-to-list 'ada-align-modes
-               '(ada-at
-                 (regexp . "\\(\\s-+\\)at\\>")
-                 (modes . '(ada-mode))))
+	       '(ada-at
+		 (regexp . "\\(\\s-+\\)at\\>")
+		 (modes . '(ada-mode))))
 
   (setq align-mode-rules-list ada-align-modes)
 
@@ -1342,6 +1331,9 @@ If you use ada-xref.el:
   ;;  Support for indent-new-comment-line (Especially for XEmacs)
   (set (make-local-variable 'comment-multi-line) nil)
 
+  ;;  Support for add-log
+  (set (make-local-variable 'add-log-current-defun-function) 'ada-which-function)
+
   (setq major-mode 'ada-mode
 	mode-name "Ada")
 
@@ -3506,11 +3498,13 @@ Moves point to the matching block start."
 Assumes point to be already positioned by `ada-goto-matching-start'.
 Moves point to the beginning of the declaration."
 
-  ;; named block without a `declare'
+  ;; named block without a `declare'; ada-goto-matching-start leaves
+  ;; point at start of 'begin' for a block.
   (if (save-excursion
 	(ada-goto-previous-word)
 	(looking-at (concat "\\<" defun-name "\\> *:")))
       t                                 ; do nothing
+    ;; else
     ;;
     ;; 'accept' or 'package' ?
     ;;
@@ -3524,7 +3518,9 @@ Moves point to the beginning of the declaration."
       ;; a named 'declare'-block ? => jump to the label
       ;;
       (if (looking-at "\\<declare\\>")
-	  (backward-word 1)
+	  (progn
+	    (forward-comment -1)
+	    (backward-word 1))
 	;;
 	;; no, => 'procedure'/'function'/'task'/'protected'
 	;;
@@ -5043,9 +5039,9 @@ Used in `ff-pre-load-hook'."
   (save-excursion
     (end-of-line);;  make sure we get the complete name
     (or (if (re-search-backward ada-procedure-start-regexp nil t)
-            (setq ff-function-name (match-string 5)))
-        (if (re-search-backward ada-package-start-regexp nil t)
-            (setq ff-function-name (match-string 4))))
+	    (setq ff-function-name (match-string 5)))
+	(if (re-search-backward ada-package-start-regexp nil t)
+	    (setq ff-function-name (match-string 4))))
     ))
 
 
@@ -5190,6 +5186,9 @@ Return nil if no body was found."
   ;; Mark single quotes as having string quote syntax in 'c' instances.
   ;; We used to explicitly avoid ''' as a special case for fear the buffer
   ;; be highlighted as a string, but it seems this fear is unfounded.
+  ;;
+  ;; This sets the properties of the characters, so that ada-in-string-p
+  ;; correctly handles '"' too...
   '(("[^a-zA-Z0-9)]\\('\\)[^\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
     ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))))
 
@@ -5243,7 +5242,7 @@ Return nil if no body was found."
 		"null" "or" "others" "overriding" "private" "protected" "raise"
 		"range" "record" "rem" "renames" "requeue" "return" "reverse"
 		"select" "separate" "synchronized" "tagged" "task" "terminate"
-                "then" "until" "when" "while" "with" "xor") t)
+		"then" "until" "when" "while" "with" "xor") t)
 	     "\\>")
      ;;
      ;; Anything following end and not already fontified is a body name.
@@ -5380,13 +5379,15 @@ for `ada-procedure-start-regexp'."
 	(insert "end " procname ";")
 	(ada-indent-newline-indent)
 	)
-       ;; else
+
        ((looking-at "[ \t\n]*is")
 	;; do nothing
 	)
+
        ((looking-at "[ \t\n]*rename")
 	;; do nothing
 	)
+
        (t
 	(message "unknown syntax"))))
      (t
@@ -5510,7 +5511,6 @@ This function typically is to be hooked into `ff-file-created-hook'."
 (autoload 'ada-point-and-xref               "ada-xref" nil t)
 (autoload 'ada-reread-prj-file              "ada-xref" nil t)
 (autoload 'ada-run-application              "ada-xref" nil t)
-(autoload 'ada-set-default-project-file     "ada-xref" nil nil)
 (autoload 'ada-set-default-project-file     "ada-xref" nil t)
 (autoload 'ada-xref-goto-previous-reference "ada-xref" nil t)
 (autoload 'ada-set-main-compile-application "ada-xref" nil t)
diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el
index daa1f2b9c64..ea8319dbba5 100644
--- a/lisp/progmodes/ada-prj.el
+++ b/lisp/progmodes/ada-prj.el
@@ -122,7 +122,8 @@ If the current value of FIELD is the default value, returns an empty string."
 (defun ada-prj-save ()
   "Save the edited project file."
   (interactive)
-  (let ((file-name (plist-get ada-prj-current-values 'filename))
+  (let ((file-name (or (plist-get ada-prj-current-values 'filename)
+		       (read-file-name "Save project as: ")))
 	output)
     (set 'output
 	 (concat
@@ -141,7 +142,6 @@ If the current value of FIELD is the default value, returns an empty string."
 
 	  ;;  Always save the fields that depend on the current buffer
 	  "main="      (plist-get ada-prj-current-values 'main) "\n"
-	  "main_unit=" (plist-get ada-prj-current-values 'main_unit) "\n"
 	  "build_dir=" (plist-get ada-prj-current-values 'build_dir) "\n"
 	  (ada-prj-set-list "check_cmd"
 			    (plist-get ada-prj-current-values 'check_cmd)) "\n"
@@ -288,26 +288,22 @@ The current buffer must be the project editing buffer."
     (widget-insert "Project file name:\n")
     (widget-insert (plist-get ada-prj-current-values 'filename))
     (widget-insert "\n\n")
-;     (ada-prj-field 'filename "Project file name"
-; "Enter the name and directory of the project
-; file. The name of the file should be the
-; name of the project itself. The extension
-; must be .adp")
-;     (ada-prj-field 'casing "Casing Exceptions Dictionnaries"
-; "List of files that contain casing exception
-; dictionnaries. All these files contain one
-; identifier per line, with a special casing.
-; The first file has the highest priority."
-;      t)
+    (ada-prj-field 'casing "Casing Exceptions"
+"List of files that contain casing exception
+dictionaries. All these files contain one
+identifier per line, with a special casing.
+The first file has the highest priority."
+      t nil
+      (mapconcat (lambda(x)
+		   (concat "           " x))
+		 (ada-xref-get-project-field 'casing)
+		 "\n")
+      )
     (ada-prj-field 'main "Executable file name"
 "Name of the executable generated when you
 compile your application. This should include
 the full directory name, using ${build_dir} if
 you wish.")
-    (ada-prj-field 'main_unit "File name of the main unit"
-"Name of the file to pass to the gnatmake command,
-and that will create the executable.
-This should not include any directory specification.")
     (ada-prj-field 'build_dir  "Build directory"
 		   "Reference directory for relative paths in
 src_dir and obj_dir below. This is also the directory
@@ -513,10 +509,8 @@ If FILENAME is given, edit that file."
 	    (ada-reread-prj-file ada-prj-default-project-file)
 	  (ada-reread-prj-file)))
 
-      ;;  Else start the interactive editor
       (switch-to-buffer "*Edit Ada Mode Project*")
 
-      (ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer)
       (ada-prj-initialize-values 'ada-prj-current-values
 				 ada-buffer
 				 ada-prj-default-project-file)
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index cea783e60bb..e9b71d95a02 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -68,6 +68,13 @@ If nil, the cross-reference mode never runs gcc."
 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.
@@ -94,6 +101,20 @@ but only ADA_INCLUDE_PATH."
   "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
+  (if (or (equal system-type 'windows-nt)
+	  (equal system-type 'ms-dos))
+      ";"
+    ":")
+  "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
@@ -123,7 +144,7 @@ the filename at the end.  This is the same syntax as in the project file."
   :type 'string :group 'ada)
 
 (defcustom ada-prj-default-make-cmd
-  (concat "${cross_prefix}gnatmake -o ${main} ${main_unit} ${gnatmake_opt} "
+  (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."
@@ -217,7 +238,7 @@ we need to use `/d' or the drive is never changed.")
 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-xref-set-default-prj-values' for the list of valid properties.
+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
@@ -260,68 +281,142 @@ project file, a (nil . default-properties) entry is created.")
 
 (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"
-  (or (ada-find-file-in-dir exec-name exec-path)
-      (ada-find-file-in-dir (concat exec-name ".exe") exec-path)
-      exec-name))
+  (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."
-  (save-excursion
-    (setq ada-xref-runtime-library-specs-path '()
-	  ada-xref-runtime-library-ali-path   '())
-    (set-buffer (get-buffer-create "*gnatls*"))
-    (widen)
-    (erase-buffer)
-    ;;  Catch any error in the following form (i.e gnatls was not found)
-    (condition-case nil
-	;;  Even if we get an error, delete the *gnatls* buffer
-	(unwind-protect
-	    (progn
-	      (let ((gnatls
-		     (ada-find-executable (concat cross-prefix "gnatls"))))
-		 (apply 'call-process gnatls (append '(nil t nil) ada-gnatls-args)))
-	      (goto-char (point-min))
-
-	      ;;  Source path
-
-	      (search-forward "Source Search Path:")
-	      (forward-line 1)
-	      (while (not (looking-at "^$"))
-		(back-to-indentation)
-		(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)
+  (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)
+		  (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)
 				  (save-excursion (end-of-line) (point)))))
-		(forward-line 1))
-
-	      ;;  Object path
-
-	      (search-forward "Object Search Path:")
-	      (forward-line 1)
-	      (while (not (looking-at "^$"))
-		(back-to-indentation)
-		(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)
-				(save-excursion (end-of-line) (point)))))
-		(forward-line 1))
-	      )
-	    (kill-buffer nil))
-      (error nil))
+		  (forward-line 1))
+
+		;;  Object path
+
+		(search-forward "Object Search Path:")
+		(forward-line 1)
+		(while (not (looking-at "^$"))
+		  (back-to-indentation)
+		  (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)
+				  (save-excursion (end-of-line) (point)))))
+		  (forward-line 1))
+		)
+	    (kill-buffer nil))))
+
     (set 'ada-xref-runtime-library-specs-path
 	 (reverse ada-xref-runtime-library-specs-path))
     (set '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.
+Returns 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."
+  (save-excursion
+    (set-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
+	    (if (looking-at "<Current_Directory>")
+		(add-to-list 'src-dir  (expand-file-name "."))
+	      (add-to-list 'src-dir
+			   (expand-file-name
+			    (buffer-substring-no-properties
+			     (point) (line-end-position)))))
+	    (forward-line 1))
+
+	  ;;  Object path
+
+	  (search-forward "Object Search Path:")
+	  (forward-line 1)
+	  (while (not (looking-at "^$"))
+	    (back-to-indentation)
+	    (if (looking-at "<Current_Directory>")
+		(add-to-list 'obj-dir (expand-file-name "."))
+	      (add-to-list 'obj-dir
+			   (expand-file-name
+			    (buffer-substring-no-properties
+			     (point) (line-end-position)))))
+	    (forward-line 1))
+
+	  ;; Set properties
+	  (setq plist (plist-put plist 'gpr_file gpr-file))
+	  (setq plist (plist-put plist 'src_dir (reverse src-dir)))
+	  (plist-put plist 'obj_dir (reverse obj-dir))
+	  )
+      (kill-buffer nil)
+      (message "Parsing %s ... done" gpr-file)
+      )
+    ))
+
 (defun ada-treat-cmd-string (cmd-string)
-  "Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.
+  "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
@@ -355,60 +450,8 @@ replaced by the name including the extension."
 			    (mapconcat (lambda(x) (concat prefix x)) value " ")
 			    t t cmd-string)))))
       ))
-  cmd-string)
+  (substitute-in-file-name cmd-string))
 
-(defun ada-xref-set-default-prj-values (symbol ada-buffer)
-  "Reset the properties in SYMBOL to the default values for ADA-BUFFER."
-
-  (let ((file      (buffer-file-name ada-buffer))
-	plist)
-    (save-excursion
-      (set-buffer ada-buffer)
-
-      (set 'plist
-	   ;;  Try hard to find a project file, even if the current
-	   ;;  buffer is not an Ada file or not associated with a file
-	   (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 ".")
-		 'casing          (if (listp ada-case-exception-file)
-				      ada-case-exception-file
-				    (list ada-case-exception-file))
-		 'comp_opt        ada-prj-default-comp-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
-				      (file-name-nondirectory
-				       (file-name-sans-extension file))
-				    "")
-		 'main_unit       (if file
-				      (file-name-nondirectory
-				       (file-name-sans-extension file))
-				    "")
-		 'cross_prefix    ""
-		 'remote_machine  ""
-		 'comp_cmd        (list ada-prj-default-comp-cmd)
-		 'check_cmd       (list ada-prj-default-check-cmd)
-		 'make_cmd        (list ada-prj-default-make-cmd)
-		 'run_cmd         (list (concat "./${main}" (if is-windows ".exe")))
-		 'debug_pre_cmd   (list (concat ada-cd-command " ${build_dir}"))
-		 'debug_cmd       (concat ada-prj-default-debugger
-					  " ${main}" (if is-windows ".exe"))
-		 'debug_post_cmd  (list nil)))
-      )
-    (set symbol plist)))
 
 (defun ada-xref-get-project-field (field)
   "Extract the value of FIELD from the current project file.
@@ -419,12 +462,20 @@ Note that for src_dir and obj_dir, you should rather use
 which will in addition return the default paths."
 
   (let* ((project-plist (cdr (ada-xref-current-project)))
-	 value)
+	 (value (plist-get project-plist field)))
 
-    (set '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)))))
 
-    ;;  Substitute the ${...} constructs in all the strings, including
-    ;;  inside lists
+     ;; 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))
@@ -485,22 +536,16 @@ All the directories are returned as absolute directories."
 	   ["New..."  ada-prj-new t]
 	   ["Edit..." ada-prj-edit t]
 	   "---"
-	   ;;  Add the new items
+	   ;;  Add the project files
 	   ,@(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))))
+		(let* ((name (or (car x) "<default>"))
+		       (command `(lambda ()
+				   "Select the current project file."
+				   (interactive)
+				   (ada-select-prj-file ,name))))
 		  (vector
-		   (if (string= (file-name-extension name)
-				ada-prj-file-extension)
-		       (file-name-sans-extension
-			(file-name-nondirectory name))
-		     (file-name-nondirectory name))
+		   (file-name-nondirectory name)
 		   command
 		   :button (cons
 			    :toggle
@@ -508,9 +553,6 @@ All the directories are returned as absolute directories."
 				   (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)))
@@ -570,22 +612,20 @@ Completion is available."
 (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 (not (ada-xref-current-project t))
-      (ada-reread-prj-file)))
+  (if (string= "" ada-prj-default-project-file)
+      (ada-reread-prj-file (ada-prj-find-prj-file t))))
 
-(defun ada-xref-current-project-file (&optional no-user-question)
-  "Return the current project file name; never nil unless NO-USER-QUESTION.
-If NO-USER-QUESTION, don't prompt user for file.  Call
-`ada-require-project-file' first if a project must exist."
+(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 nil no-user-question)))
+    (ada-prj-find-prj-file t)))
 
-(defun ada-xref-current-project (&optional no-user-question)
-  "Return the current project; nil if none.
-If NO-USER-QUESTION, don't prompt user for file.  Call
-`ada-require-project-file' first if a project must exist."
-  (let* ((file-name (ada-xref-current-project-file no-user-question)))
+(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 ()
@@ -594,9 +634,9 @@ If NO-USER-QUESTION, don't prompt user for file.  Call
   (message (ada-xref-current-project-file)))
 
 (defun ada-show-current-main ()
-  "Display current main unit name in message buffer."
+  "Display current main file name in message buffer."
   (interactive)
-  (message "ada-mode main_unit: %s" (ada-xref-get-project-field 'main_unit)))
+  (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."
@@ -619,23 +659,16 @@ This is overridden on VMS to convert from VMS filenames to Unix filenames."
   name)
 ;; FIXME: use convert-standard-filename instead
 
-(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."
+(defun ada-set-default-project-file (file)
+  "Set FILE as the current project file."
   (interactive "fProject file:")
-  (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))))
+  (ada-parse-prj-file file)
+  (ada-select-prj-file file))
 
 ;; ------ Handling the project file -----------------------------
 
-(defun ada-prj-find-prj-file (&optional file no-user-question)
-  "Find the project file associated with FILE (or the current buffer if nil).
+(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
@@ -647,19 +680,15 @@ is non-nil, prompt the user to select one.  If none are found, return
   (let (selected)
 
     (if (not (and (derived-mode-p 'ada-mode)
-                  buffer-file-name))
+		  buffer-file-name))
 
 	;;  Not in an Ada buffer, or current buffer not associated
 	;;  with a file (for instance an emerge buffer)
-
-	(if (and ada-prj-default-project-file
-		 (not (string= ada-prj-default-project-file "")))
-	    (setq selected ada-prj-default-project-file)
-	  (setq selected nil))
+	(setq selected nil)
 
       ;;  other cases: use a more complex algorithm
 
-      (let* ((current-file (or file (buffer-file-name)))
+      (let* ((current-file (buffer-file-name))
 	     (first-choice (concat
 			    (file-name-sans-extension current-file)
 			    ada-prj-file-extension))
@@ -721,155 +750,220 @@ is non-nil, prompt the user to select one.  If none are found, return
     (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  ""
+     '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 is-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 is-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 it as the active project."
-  ;; FIXME: doc nil, search, etc.
-  (if prj-file
-      (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)))
-	(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
-	;;  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.
-
-	(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
-		     ;; fields that are lists or paths require special processing
-		     ;; FIXME: strip trailing spaces
-		     ((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
-		      ;; any other field in the file is just copied
-		      (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))))
-	      (if debug_post_cmd (set 'project (plist-put project 'debug_post_cmd
-                                                          (reverse debug_post_cmd))))
-	      (if debug_pre_cmd (set 'project (plist-put project 'debug_pre_cmd
-                                                         (reverse debug_pre_cmd))))
-
-	      (set-buffer ada-buffer)
-	      )
+  "Read PRJ-FILE, set project properties in `ada-xref-project-files'."
+  (let ((project (ada-default-prj-properties)))
 
-	  ;;  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))))
-	  )
+    (setq prj-file (expand-file-name prj-file))
+    (if (string= (file-name-extension prj-file) "gpr")
+	(set 'project (ada-gnat-parse-gpr project prj-file))
+
+      (set '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)))
 
-	;;  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))
+    (ada-xref-update-project-menu)
+    ))
 
-	;;  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)))
+(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))
 
-	;; Sets up the compilation-search-path so that Emacs is able to
-	;; go to the source of the errors in a compilation buffer
-	(setq compilation-search-path (ada-xref-get-src-dir-field))
+    (widen)
+    (goto-char (point-min))
 
-	;; Set the casing exceptions file list
-	(if casing
-	    (progn
-	      (setq ada-case-exception-file (reverse casing))
-	      (ada-case-read-exceptions)))
+    ;; process each line
+    (while (not (eobp))
 
-	;; Add the directories to the search path for ff-find-other-file
-	;; Do not add the '/' or '\' at the end
-	(setq ada-search-directories-internal
-	     (append (mapcar 'directory-file-name compilation-search-path)
-		     ada-search-directories))
+      ;; 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")
+	    (add-to-list 'ada_project_path
+			 (expand-file-name
+			  (substitute-in-file-name (match-string 2)))))
 
-	(ada-xref-update-project-menu)
-	)
+	   ((string= (match-string 1) "build_dir")
+	    (set 'project
+		 (plist-put project 'build_dir
+			    (file-name-as-directory (match-string 2)))))
 
-    ;;  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))
+	   ((string= (match-string 1) "casing")
+	    (add-to-list 'casing
+			 (expand-file-name (substitute-in-file-name (match-string 2)))))
+
+	   ((string= (match-string 1) "check_cmd")
+	    (add-to-list 'check_cmd (match-string 2)))
+
+	   ((string= (match-string 1) "comp_cmd")
+	    (add-to-list 'comp_cmd (match-string 2)))
+
+	   ((string= (match-string 1) "debug_post_cmd")
+	    (add-to-list 'debug_post_cmd (match-string 2)))
+
+	   ((string= (match-string 1) "debug_pre_cmd")
+	    (add-to-list 'debug_pre_cmd (match-string 2)))
+
+	   ((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")
+	    (add-to-list 'make_cmd (match-string 2)))
+
+	   ((string= (match-string 1) "obj_dir")
+	    (add-to-list 'obj_dir
+			 (file-name-as-directory
+			  (expand-file-name (match-string 2)))))
+
+	   ((string= (match-string 1) "run_cmd")
+	    (add-to-list 'run_cmd (match-string 2)))
+
+	   ((string= (match-string 1) "src_dir")
+	    (add-to-list 'src_dir
+			 (file-name-as-directory
+			  (expand-file-name (match-string 2)))))
+
+	   (t
+	    ;; any other field in the file is just copied
+	    (set '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))
+	  (set '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 (set 'project (plist-put project 'debug_post_cmd (reverse debug_post_cmd))))
+    (if debug_pre_cmd (set 'project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd))))
+    (if casing (set 'project (plist-put project 'casing (reverse casing))))
+    (if check_cmd (set 'project (plist-put project 'check_cmd (reverse check_cmd))))
+    (if comp_cmd (set 'project (plist-put project 'comp_cmd (reverse comp_cmd))))
+    (if make_cmd (set 'project (plist-put project 'make_cmd (reverse make_cmd))))
+    (if run_cmd (set 'project (plist-put project 'run_cmd (reverse run_cmd))))
+
+    (if gpr_file
+	(progn
+	  (set '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 (set 'project (plist-put project 'obj_dir (reverse obj_dir))))
+    (if src_dir (set '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.
@@ -927,7 +1021,9 @@ buffer `*gnatfind*', if there is one."
 		(concat "'\"" (substring entity 1 -1) "\"'"))
 	    entity))
 	 (switches (ada-xref-get-project-field 'gnatfind_opt))
-	 (command (concat "gnat find " switches " "
+	 ;; 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))
@@ -941,8 +1037,8 @@ buffer `*gnatfind*', if there is one."
 	     (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))))
+	    (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))
 	(save-excursion
@@ -1087,8 +1183,9 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
 
 (defun ada-get-absolute-dir-list (dir-list root-dir)
   "Return the list of absolute directories found in DIR-LIST.
-If a directory is a relative directory, ROOT-DIR is prepended."
-  (mapcar (lambda (x) (expand-file-name x root-dir)) 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.
@@ -1148,7 +1245,7 @@ If ARG is not nil, ask for user confirmation."
     (compile (ada-quote-cmd cmd))))
 
 (defun ada-set-main-compile-application ()
-  "Set main_unit and main project variables to current buffer, build main."
+  "Set main project variable to current buffer, build main."
   (interactive)
   (ada-require-project-file)
   (let* ((file (buffer-file-name (current-buffer)))
@@ -1162,7 +1259,6 @@ If ARG is not nil, ask for user confirmation."
 		 (file-name-sans-extension file))
 	      ""))
       (ada-xref-set-project-field 'main main)
-      (ada-xref-set-project-field 'main_unit main)
       (ada-compile-application))))
 
 (defun ada-compile-current (&optional arg prj-field)
@@ -1177,8 +1273,6 @@ command, and should be either `comp_cmd' (default) or `check_cmd'."
 	 (process-environment (ada-set-environment))
 	 (compilation-scroll-output t))
 
-    (setq compilation-search-path (ada-xref-get-src-dir-field))
-
     (unless cmd
       (setq cmd '("") arg t))
 
@@ -1354,16 +1448,13 @@ project file."
       )))
 
 (defun ada-reread-prj-file (&optional filename)
-  "Reread either the current project, or FILENAME if non-nil."
+  "Reread either the current project, or FILENAME if non-nil.
+If FILENAME is non-nil, set it as current project."
   (interactive "P")
-  (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) ""))
-  )
+  (if (not filename)
+    (setq filename ada-prj-default-project-file))
+  (ada-parse-prj-file filename)
+  (ada-select-prj-file filename))
 
 ;; ------ Private routines
 
@@ -2184,8 +2275,8 @@ Return the position of the declaration in the buffer, or nil if not found."
 (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)
-    (setq krunch-buf (generate-new-buffer "*gkrunch*"))
+  (let ((krunch-buf (generate-new-buffer "*gkrunch*"))
+	(cross-prefix (plist-get plist 'cross_prefix)))
     (save-excursion
       (set-buffer krunch-buf)
       ;; send adaname to external process `gnatkr'.
@@ -2193,7 +2284,7 @@ This is a GNAT specific function that uses gnatkrunch."
       ;; behaviors depending on the version:
       ;;   Up to 3.15:   "AA.BB.CC"  =>  aa-bb-cc
       ;;   After:        "AA.BB.CC"  =>  aa-bb.cc
-      (call-process "gnatkr" nil krunch-buf nil
+      (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
@@ -2211,33 +2302,40 @@ This is a GNAT specific function that uses gnatkrunch."
 
 (defun ada-make-body-gnatstub (&optional interactive)
   "Create an Ada package body in the current buffer.
-This function uses the `gnatstub' program to create the body.
-If INTERACTIVE is nil, kill the current buffer.
-This function typically is to be hooked into `ff-file-created-hook'."
+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)
 
-  (save-some-buffers nil nil)
-
-  ;; If the current buffer is the body (as is the case when calling this
-  ;; function from ff-file-created-hook), then kill this temporary buffer
+  ;; 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 (this might not be the case
-  ;;  if for instance the user was asked for a project file)
+  ;; Make sure the current buffer is the spec, 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 gnatstub
-  (let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
+  ;; 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"))
-	 (gnatstub-cmd  (concat "gnatstub " gnatstub-opts " " filename))
-	 (buffer        (get-buffer-create "*gnatstub*")))
+	 (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*")))
 
     (save-excursion
       (set-buffer buffer)
@@ -2246,30 +2344,18 @@ This function typically is to be hooked into `ff-file-created-hook'."
       (insert gnatstub-cmd)
       (newline)
       )
-    ;; call gnatstub to create the body file
-    (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd)
 
-    (if (save-excursion
-	  (set-buffer buffer)
-	  (goto-char (point-min))
-	  (search-forward "command not found" nil t))
-	(progn
-	  (message "gnatstub was not found -- using the basic algorithm")
-	  (sleep-for 2)
-	  (kill-buffer buffer)
-	  (ada-make-body))
+    (call-process shell-file-name nil buffer nil "-c" gnatstub-cmd)
 
-      ;; Else clean up the output
+    ;; clean up the output
 
-      (if (file-exists-p output)
-	  (progn
-	    (find-file output)
-	    (kill-buffer buffer))
+    (if (file-exists-p output)
+	(progn
+	  (find-file output)
+	  (kill-buffer buffer))
 
-	;; display the error buffer
-	(display-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.
@@ -2298,14 +2384,6 @@ For instance, it creates the gnat-specific menus, sets some hooks for
      'error-message
      "File not found in src-dir (check project file): ")
 
-;;  Initializes the cross references to the runtime library
-(ada-initialize-runtime-library "")
-
-;;  Add these standard directories to the search path
-(set 'ada-search-directories-internal
-     (append (mapcar 'directory-file-name ada-xref-runtime-library-specs-path)
-	     ada-search-directories))
-
 (provide 'ada-xref)
 
 ;; arch-tag: 415a39fe-577b-4676-b3b1-6ff6db7ca24e