X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/e240ca977792a102ec63aac0909a0440adabac32..4e4c53b640bb2f6b5d9ab2f00857221dcce325b8:/packages/ada-mode/gnat-core.el

diff --git a/packages/ada-mode/gnat-core.el b/packages/ada-mode/gnat-core.el
old mode 100755
new mode 100644
index 38dd80e10..a9d79ea8b
--- a/packages/ada-mode/gnat-core.el
+++ b/packages/ada-mode/gnat-core.el
@@ -36,7 +36,7 @@
 
     (cond
      ((listp prj-dir)
-	(add-to-list 'prj-dir dir))
+      (cl-pushnew dir prj-dir :test #'equal))
 
      (prj-dir
       (setq prj-dir (list dir)))
@@ -56,6 +56,18 @@
 
     project))
 
+(defun gnat-prj-show-path ()
+  "For `ada-prj-show-path'."
+    (interactive)
+  (if (ada-prj-get 'prj_dir)
+      (progn
+	(pop-to-buffer (get-buffer-create "*GNAT project search path*"))
+	(erase-buffer)
+	(dolist (file (ada-prj-get 'prj_dir))
+	  (insert (format "%s\n" file))))
+    (message "no GNAT project search path files")
+    ))
+
 (defun gnat-prj-parse-emacs-one (name value project)
   "Handle gnat-specific Emacs Ada project file settings.
 Return new PROJECT if NAME recognized, nil otherwise.
@@ -87,7 +99,7 @@ See also `gnat-parse-emacs-final'."
     (kill-buffer (gnat-run-buffer-name))); things may have changed, force re-create
 
   (if (ada-prj-get 'gpr_file project)
-      (set 'project (gnat-parse-gpr (ada-prj-get 'gpr_file project) project))
+      (setq project (gnat-parse-gpr (ada-prj-get 'gpr_file project) project))
 
     ;; add the compiler libraries to src_dir
     (setq project (gnat-get-paths project))
@@ -97,7 +109,7 @@ See also `gnat-parse-emacs-final'."
 
 (defun gnat-get-paths-1 (src-dirs prj-dirs)
   "Append list of source and project dirs in current gpr project to SRC-DIRS, PRJ-DIRS.
-Uses 'gnat list'. Returns new '(src-dirs prj-dirs)."
+Uses 'gnat list'.  Returns new (SRC-DIRS PRJ-DIRS)."
   (with-current-buffer (gnat-run-buffer)
     ;; gnat list -v -P can return status 0 or 4; always lists compiler dirs
     ;;
@@ -116,12 +128,14 @@ Uses 'gnat list'. Returns new '(src-dirs prj-dirs)."
 	  (forward-line 1)
 	  (while (not (looking-at "^$")) ; terminate on blank line
 	    (back-to-indentation) ; skip whitespace forward
-	    (if (looking-at "<Current_Directory>")
-		(add-to-list 'src-dirs  (directory-file-name default-directory))
-	      (add-to-list 'src-dirs
-			   (expand-file-name ; canonicalize path part
+            (cl-pushnew (if (looking-at "<Current_Directory>")
+                             (directory-file-name default-directory)
+                           (expand-file-name ; Canonicalize path part.
 			    (directory-file-name
-			     (buffer-substring-no-properties (point) (point-at-eol))))))
+			     (buffer-substring-no-properties
+                              (point) (point-at-eol)))))
+                        src-dirs
+                        :test #'equal)
 	    (forward-line 1))
 
 	  ;; Project path
@@ -133,17 +147,16 @@ Uses 'gnat list'. Returns new '(src-dirs prj-dirs)."
 	  (while (not (looking-at "^$"))
 	    (back-to-indentation)
 	    (if (looking-at "<Current_Directory>")
-		(add-to-list 'prj-dirs ".")
-	      (add-to-list 'prj-dirs
-			   (expand-file-name
-			    (buffer-substring-no-properties (point) (point-at-eol))))
-	      (add-to-list 'src-dirs
-			   (expand-file-name
-			    (buffer-substring-no-properties (point) (point-at-eol)))))
+                (cl-pushnew "." prj-dirs :test #'equal)
+              (let ((f (expand-file-name
+                        (buffer-substring-no-properties
+                         (point) (point-at-eol)))))
+                (cl-pushnew f prj-dirs :test #'equal)
+                (cl-pushnew f src-dirs :test #'equal)))
 	    (forward-line 1))
 
 	  )
-      ('error
+      (error
        (pop-to-buffer (current-buffer))
        ;; search-forward failed
        (error "parse gpr failed")
@@ -155,8 +168,9 @@ Uses 'gnat list'. Returns new '(src-dirs prj-dirs)."
   (let ((src-dirs (ada-prj-get 'src_dir project))
 	(prj-dirs (ada-prj-get 'prj_dir project)))
 
-    ;; FIXME: use a dispatching function instead, to avoid "require" here,
-    ;; which gives "warning: function not known".
+    ;; FIXME: use a dispatching function instead, with autoload, to
+    ;; avoid "require" here, which gives "warning: function not
+    ;; known".
     ;; Using 'require' at top level gives the wrong default ada-xref-tool
     (cl-ecase (ada-prj-get 'xref_tool project)
       ((gnat gnat_inspect)
@@ -165,9 +179,10 @@ Uses 'gnat list'. Returns new '(src-dirs prj-dirs)."
 	 (setq prj-dirs (cadr res))))
 
       (gpr_query
-       (require 'gpr-query)
-       (setq src-dirs (gpr-query-get-src-dirs src-dirs))
-       (setq prj-dirs (gpr-query-get-prj-dirs prj-dirs)))
+       (when (ada-prj-get 'gpr_file)
+	 (require 'gpr-query)
+	 (setq src-dirs (gpr-query-get-src-dirs src-dirs))
+	 (setq prj-dirs (gpr-query-get-prj-dirs prj-dirs))))
       )
 
     (setq project (plist-put project 'src_dir (reverse src-dirs)))
@@ -224,6 +239,10 @@ src_dir will include compiler runtime."
 	)
       buffer)))
 
+(defun ada-gnat-show-run-buffer ()
+  (interactive)
+  (pop-to-buffer (gnat-run-buffer)))
+
 (defun gnat-run (exec command &optional err-msg expected-status)
   "Run a gnat command line tool, as \"EXEC COMMAND\".
 EXEC must be an executable found on `exec-path'.
@@ -409,11 +428,8 @@ list."
     ;; need -f gnat stub option. We won't get here if there is an
     ;; existing body file.
     (save-some-buffers t)
-    (add-to-list 'opts "-f")
+    (cl-pushnew "-f" opts :test #'equal)
     (with-current-buffer (gnat-run-buffer)
-      ;; FIXME: gnat-run-buffer requires a project, but we don't
-      ;; actually need one. Just use a temp buffer. Same for other
-      ;; uses of gnat-run-no-prj.
       (gnat-run-no-prj
        (append (list "stub") opts (list start-file "-cargs") switches)
        (file-name-directory body-file-name))