[Ada-mode-users] [patch] Allow C-u C-c C-r to retain the previous cross references in the compilation buffer

[Ludovic Brenta]

Hello,

C-c C-r always deletes the contents of the buffer containing
cross-references before launching gnat find.  With this patch,
it is possible to retain the old information with a prefix argument:
C-u C-c C-r.

--
Ludovic Brenta.

Index: ada-mode/ada-gnat-xref.el
==================================================================
--- ada-mode/ada-gnat-xref.el
+++ ada-mode/ada-gnat-xref.el
@@ -34,10 +34,11 @@
 ;; special needs to done to use it.

 (require 'ada-fix-error)
 (require 'compile)
 (require 'gnat-core)
+(require 'cl)

 ;;;;; code

 ;;;; uses of gnat tools

@@ -104,12 +105,12 @@
                    "-d"
 		    (when (ada-prj-get 'gpr_ext) (concat "--ext=" (ada-prj-get 
'gpr_ext)))
                    ))
         (dirs (when (ada-prj-get 'obj_dir)
                 (concat "-aO" (mapconcat 'identity (ada-prj-get 'obj_dir) 
":"))))
-         (project-file (when (ada-prj-current-file)
-                         (concat "-p" (ada-prj-current-file))))
+         (project-file (when ada-prj-current-file
+                         (concat "-p" ada-prj-current-file)))
         (result nil))
     (with-current-buffer (gnat-run-buffer)
       (gnat-run-gnat "find" (append switches (list dirs arg 
project-file)))

       (goto-char (point-min))
@@ -144,20 +145,20 @@
                     (nth 2 result)
                     nil ;; other-window
                     )
     ))

-(defun ada-gnat-xref-all (identifier file line col)
+(defun ada-gnat-xref-all (identifier file line col &optional append)
   "For `ada-xref-all-function'."
   ;; we use `compilation-start' to run gnat, not `gnat-run', so it
   ;; is asynchronous, and automatically runs the compilation error
   ;; filter.

   (let* ((dirs (when (ada-prj-get 'obj_dir)
                 (concat "-aO" (mapconcat 'identity (ada-prj-get 'obj_dir) 
":"))))
-         (project-file (when (ada-prj-current-file)
-                         (concat "-p" (ada-prj-current-file))))
+         (project-file (when ada-prj-current-file
+                         (concat "-p" ada-prj-current-file)))
 	 (cmd (format "gnat find -a -r %s %s:%s:%d:%d %s" dirs identifier 
file line col project-file)))

     (with-current-buffer (gnat-run-buffer); for default-directory
       (let ((compilation-environment (ada-prj-get 'proc_env))
            (compilation-error "reference")
@@ -165,13 +166,18 @@
            ;; need to set compilation-error-regexp-alist
            )
        (when (ada-prj-get 'gpr_file)
 	  (setq cmd (concat cmd " -P" (file-name-nondirectory (ada-prj-get 
'gpr_file)))))

-       (compilation-start cmd
-                          'compilation-mode
-                          (lambda (name) (concat name "-gnatfind")))
+        (if append
+            (flet ((erase-buffer nil (goto-char (point-max))))
+              (compilation-start cmd
+                                 'compilation-mode
+                                 (lambda (name) (concat name 
"-gnatfind"))))
+          (compilation-start cmd
+                             'compilation-mode
+                             (lambda (name) (concat name 
"-gnatfind"))))
     ))))

 ;;;;; setup

 (defun ada-gnat-xref-select-prj ()

Index: ada-mode/ada-mode.el
==================================================================
--- ada-mode/ada-mode.el
+++ ada-mode/ada-mode.el
@@ -2309,26 +2309,31 @@
 Called with four arguments:
 - an Ada identifier or operator_symbol
 - filename containing the identifier
 - line number containing the identifier
 - column of the start of the identifier
+And an optional fifth argument:
+- append
 Displays a buffer in compilation-mode giving locations where the
-identifier is declared or referenced.")
+identifier is declared or referenced.  If append is specified and
+non-nil, append the locations to the existing gnatfind buffer, if
+there is one.")

-(defun ada-show-references ()
+(defun ada-show-references (&optional prefix)
   "Show all references of identifier at point."
-  (interactive)
+  (interactive "P")
   (ada-check-current-project (buffer-file-name))

   (when (null ada-xref-all-function)
     (error "no cross reference information available"))

   (funcall ada-xref-all-function
           (ada-identifier-at-point)
           (file-name-nondirectory (buffer-file-name))
           (line-number-at-pos)
-          (1+ (current-column)))
+          (1+ (current-column))
+           prefix)
   )

 (defvar ada-xref-overriding-function nil
   ;; determined by ada-xref-tool, set by *-select-prj
   "Function that displays cross reference information for overriding 
subprograms.