(ada-prj-default-check-cmd): New variable, replacing deleted variable

`ada-check-switch'.
(ada-project-file-extension): Rename to `ada-prj-file-extension'.
(ada-xref-project-files): Improve doc string.
(ada-find-executable): New function.
(ada-initialize-runtime-library): Use `ada-find-executable'.
(ada-xref-set-default-prj-values): In compile commands, don't
need `ada-cd-command'; `compile' does that more portably.
Use ada-prj-default-check-cmd.
(ada-parse-prj-file): Don't set 'debug_post_cmd, 'debug_pre_cmd
properties if not specified in project file.
(ada-goto-declaration): Display useful message for new error
'error-file-not-found.
(ada-get-ada-file-name, ada-find-in-src-path): Signal new error
'error-file-not-found.
(ada-get-all-references): Match latest ali syntax.
Signal new error 'error-file-not-found.
(ada-find-in-ali): Match latest ali syntax.
(ada-make-filename-from-adaname): Handle different semantics
of gnatkr in GNAT 3.15p vs later.

1 files changed, 77 insertions, 43 deletions

diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index c6fcc670038..1ee89027975 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -104,6 +104,14 @@ 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}")
@@ -171,10 +179,7 @@ file.")
 (defvar ada-last-prj-file ""
   "Name of the last project file entered by the user.")
 
-(defvar ada-check-switch "-gnats"
-  "Switch added to the command line to check the current file.")
-
-(defconst ada-project-file-extension ".adp"
+(defconst ada-prj-file-extension ".adp"
   "The extension used for project files.")
 
 (defvar ada-xref-runtime-library-specs-path '()
@@ -210,10 +215,15 @@ we need to use `/d' or the drive is never changed.")
   "Regexp to match for operators.")
 
 (defvar ada-xref-project-files '()
-  "Associative list of project files.
-It has the following format:
-\((project_name . value) (project_name . value) ...)
-As always, the values of the project file are defined through properties.")
+  "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-xref-set-default-prj-values 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 -------------------------------------------
@@ -250,6 +260,13 @@ As always, the values of the project file are defined through properties.")
   "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.
+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))
+
 (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."
@@ -264,8 +281,9 @@ CROSS-PREFIX is the prefix to use for the `gnatls' command."
 	;;  Even if we get an error, delete the *gnatls* buffer
 	(unwind-protect
 	    (progn
-	      (apply 'call-process (concat cross-prefix "gnatls")
-		     (append '(nil t nil) ada-gnatls-args))
+	      (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
@@ -384,20 +402,13 @@ replaced by the name including the extension."
 				    "")
 		 'cross_prefix    ""
 		 'remote_machine  ""
-		 'comp_cmd        (list (concat ada-cd-command " ${build_dir}")
-					ada-prj-default-comp-cmd)
-		 'check_cmd       (list (concat ada-prj-default-comp-cmd " "
-						ada-check-switch))
-		 'make_cmd        (list (concat ada-cd-command " ${build_dir}")
-					ada-prj-default-make-cmd)
-		 'run_cmd         (list (concat ada-cd-command " ${build_dir}")
-					(concat "${main}"
-						(if is-windows ".exe")))
-		 'debug_pre_cmd   (list (concat ada-cd-command
-						" ${build_dir}"))
+		 '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
-					  (if is-windows " ${main}.exe"
-					    " ${main}"))
+					  " ${main}" (if is-windows ".exe"))
 		 'debug_post_cmd  (list nil)))
       )
     (set symbol plist)))
@@ -494,7 +505,7 @@ All the directories are returned as absolute directories."
 				  (ada-xref-update-project-menu))))
 		  (vector
 		   (if (string= (file-name-extension name)
-				ada-project-file-extension)
+				ada-prj-file-extension)
 		       (file-name-sans-extension
 			(file-name-nondirectory name))
 		     (file-name-nondirectory name))
@@ -628,7 +639,7 @@ file.  If none is set, return nil."
       (let* ((current-file (or file (buffer-file-name)))
 	     (first-choice (concat
 			    (file-name-sans-extension current-file)
-			    ada-project-file-extension))
+			    ada-prj-file-extension))
 	     (dir          (file-name-directory current-file))
 
 	     ;; on Emacs 20.2, directory-files does not work if
@@ -637,7 +648,7 @@ file.  If none is set, return nil."
 	     (prj-files    (directory-files
 			    dir t
 			    (concat ".*" (regexp-quote
-					  ada-project-file-extension) "$")))
+					  ada-prj-file-extension) "$")))
 	     (choice       nil))
 
 	(cond
@@ -775,10 +786,10 @@ file.  If none is set, return nil."
 						     (reverse check_cmd))))
 	      (if run_cmd (set 'project (plist-put project 'run_cmd
 						   (reverse run_cmd))))
-	      (set 'project (plist-put project 'debug_post_cmd
-				       (reverse debug_post_cmd)))
-	      (set 'project (plist-put project 'debug_pre_cmd
-				       (reverse debug_pre_cmd)))
+	      (if 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))))
 
 	      ;; Kill the project buffer
 	      (kill-buffer nil)
@@ -1017,8 +1028,13 @@ If OTHER-FRAME is non-nil, display the cross-reference in another frame."
   ;;  that file was too old or even did not exist, try to look in the whole
   ;;  object path for a possible location.
   (let ((identlist (ada-read-identifier pos)))
-    (condition-case nil
+    (condition-case err
 	(ada-find-in-ali identlist other-frame)
+      ;; File not found: print explicit error message
+      (error-file-not-found
+       (message (concat (error-message-string err)
+			(nthcdr 1 err))))
+
       (error
        (let ((ali-file (ada-get-ali-file-name (ada-file-of identlist))))
 
@@ -1507,10 +1523,7 @@ file for possible paths."
     (let ((filename (ada-find-src-file-in-dir file)))
       (if filename
 	  (expand-file-name filename)
-	(error (concat
-		(file-name-nondirectory file)
-		" not found in src_dir; please check your project file")))
-
+	(signal 'error-file-not-found (file-name-nondirectory file)))
       )))
 
 (defun ada-find-file-number-in-ali (file)
@@ -1603,7 +1616,7 @@ Information is extracted from the ali file."
 		(concat "^"    (ada-line-of identlist)
 			"."    (ada-column-of identlist)
 			"[ *]" (ada-name-of identlist)
-			"[{\(<= ]?\\(.*\\)$") bound t))
+			"[{\[\(<= ]?\\(.*\\)$") bound t))
 	  (if declaration-found
 	      (ada-set-on-declaration identlist t))
 	  ))
@@ -1635,7 +1648,7 @@ Information is extracted from the ali file."
 		   (concat
 		    "^[0-9]+.[0-9]+[ *]"
 		    (ada-name-of identlist)
-		    "[ <{=\(]\\(.\\|\n\\.\\)*\\<"
+		    "[ <{=\(\[]\\(.\\|\n\\.\\)*\\<"
 		    (ada-line-of identlist)
 		    "[^0-9]"
 		    (ada-column-of identlist) "\\>")
@@ -1655,9 +1668,10 @@ Information is extracted from the ali file."
 	    (beginning-of-line)
 	    ;; while we have a continuation line, go up one line
 	    (while (looking-at "^\\.")
-	      (previous-line 1))
+	      (previous-line 1)
+	      (beginning-of-line))
 	    (unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
-					(ada-name-of identlist) "[ <{=\(]"))
+					(ada-name-of identlist) "[ <{=\(\[]"))
 	      (set 'declaration-found nil))))
 
       ;; Still no success ! The ali file must be too old, and we need to
@@ -1700,6 +1714,8 @@ Information is extracted from the ali file."
 					  (ada-file-of identlist)))
 
 		;;  Else clean up the ali file
+		(error-file-not-found
+		 (signal (car err) (cdr err)))
 		(error
 		 (kill-buffer ali-buffer)
 		 (error (error-message-string err)))
@@ -1817,7 +1833,7 @@ opens a new window to show the declaration."
     ;; 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)
+    (string-match "^\\([0-9]+\\)[a-zA-Z+*]\\([0-9]+\\)[ *]" ali-line)
     (set 'locations (list (list (match-string 1 ali-line) ;; line
 				(match-string 2 ali-line) ;; column
 				(ada-declare-file-of identlist))))
@@ -1828,7 +1844,10 @@ opens a new window to show the declaration."
 	    start (match-end 3))
 
       ;;  it there was a file number in the same line
-      (if (string-match (concat "[^{(<]\\([0-9]+\\)|\\([^|bc]+\\)?"
+      ;;  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)))
@@ -1997,7 +2016,7 @@ is using."
 				  (string-to-number (nth 2 (nth choice list)))
 				  identlist
 				  other-frame)
-	(error (concat (car (nth choice list)) " not found in src_dir")))
+	(signal 'error-file-not-found (car (nth choice list))))
       (message "This is only a (good) guess at the cross-reference.")
       ))))
 
@@ -2137,8 +2156,12 @@ This is a GNAT specific function that uses gnatkrunch."
     (save-excursion
       (set-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 "gnatkr" nil krunch-buf nil
-		    adaname ada-krunch-args)
+		    (concat adaname ".adb") ada-krunch-args)
       ;; fetch output of that process
       (setq adaname (buffer-substring
 		     (point-min)
@@ -2146,6 +2169,9 @@ This is a GNAT specific function that uses gnatkrunch."
 		       (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
   )
@@ -2234,6 +2260,14 @@ find-file...."
 ;;  This must be done before initializing the Ada menu.
 (add-hook 'ada-mode-hook 'ada-xref-initialize)
 
+;;  Define a new error type
+(put 'error-file-not-found
+     'error-conditions
+     '(error ada-mode-errors error-file-not-found))
+(put 'error-file-not-found
+     'error-message
+     "File not found in src-dir (check project file): ")
+
 ;;  Initializes the cross references to the runtime library
 (ada-initialize-runtime-library "")