Mercurial > emacs

changeset 45930:dd1d952f59c2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Update copyright notice. (ada-xref-create-ali): The default is now not to create automatically the ALI files by compiling the unit, since this isn't always reliable and requires an up-to-date project file. (ada-prj-default-comp-cmd): No longer use gcc directly to compile a file, but use gnatmake instead, since this gives access to the GNAT project files. (ada-xref-search-with-egrep): New variable, suggested by P. Waroquiers. (ada-load-project-hook): New variable, for support of GNAT project files. (ada-update-project-menu): Fix the detection of the project file name. (ada-add-keymap): Change key binding for ada-find-file, that conflicted with another binding in ada-mode.el. (ada-add-menu): New menu "List Local References", to list the reference to the entity only in the current file, instead of looking in the whole project. Much faster. (ada-find-references): New parameters arg and local-only. (ada-find-any-references): New parameters local-only and append. (ada-goto-declaration): Fix handling of predefined entities in xref. (ada-get-all-references): Updated to the new xref format in GNAT 3.15, still compatible with GNAT 3.14 of course. Fix various calls to count-lines, that didn't work correctly when the buffer was narrowed.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Thu, 20 Jun 2002 17:31:56 +0000
parents 8542d59b76af
children a4c8d672ccbe
files lisp/progmodes/ada-xref.el
diffstat 1 files changed, 124 insertions(+), 49 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/progmodes/ada-xref.el	Thu Jun 20 17:17:32 2002 +0000
+++ b/lisp/progmodes/ada-xref.el	Thu Jun 20 17:31:56 2002 +0000
@@ -1,13 +1,13 @@
 ;;; ada-xref.el --- for lookup and completion in Ada mode
 
-;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 2001, 2002
 ;;    Free Software Foundation, Inc.
 
 ;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
 ;;      Rolf Ebert <ebert@inf.enst.fr>
 ;;      Emmanuel Briot <briot@gnat.com>
 ;; Maintainer: Emmanuel Briot <briot@gnat.com>
-;; Ada Core Technologies's version:   $Revision: 1.9 $
+;; Ada Core Technologies's version:   Revision: 1.155.2.8 (GNAT 3.15)
 ;; Keywords: languages ada xref
 
 ;; This file is part of GNU Emacs.
@@ -51,7 +51,7 @@
 Otherwise create either a new buffer or a new frame."
   :type 'boolean :group 'ada)
 
-(defcustom ada-xref-create-ali t
+(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 will never run gcc."
   :type 'boolean :group 'ada)
@@ -91,7 +91,8 @@
   :type 'string :group 'ada)
 
 (defcustom ada-prj-default-comp-cmd
-  "${cross_prefix}gcc -x ada -c ${comp_opt} ${full_current}"
+  (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 add the filename at the end of this command. This is the same
 syntax as in the project file."
@@ -132,6 +133,26 @@
   "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging.
 If GVD is not the debugger used, nothing happens.")
 
+(defcustom ada-xref-search-with-egrep t
+  "*If non-nil, use egrep 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.")
@@ -289,10 +310,10 @@
 	   ;;  Ada file or not even associated with a file
 	   (list 'filename (expand-file-name
 			    (cond
+			     (ada-prj-default-project-file
+			      ada-prj-default-project-file)
 			     (file
 			      (ada-prj-get-prj-dir file))
-			     (ada-prj-default-project-file
-			      ada-prj-default-project-file)
 			     (t
 			      (message (concat "Not editing an Ada file,"
 					       "and no default project "
@@ -436,8 +457,12 @@
 	      (append submenu
 		      (list (cons (intern name)
 				  (list
-				   'menu-item (file-name-sans-extension
-					       (file-name-nondirectory name))
+				   'menu-item
+				   (if (string= (file-name-extension name)
+						ada-project-file-extension)
+				       (file-name-sans-extension
+					(file-name-nondirectory name))
+				     (file-name-nondirectory name))
 				   command
 				   :button (cons
 					    :toggle
@@ -515,7 +540,6 @@
   (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame)
   (define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration)
   (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference)
-  (define-key ada-mode-map "\C-c\C-x" 'ada-reread-prj-file)
   (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application)
   (define-key ada-mode-map "\C-cc"  'ada-change-prj)
   (define-key ada-mode-map "\C-cd"  'ada-set-default-project-file)
@@ -523,8 +547,9 @@
   (define-key ada-mode-map "\C-cr"  'ada-run-application)
   (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent)
   (define-key ada-mode-map "\C-c\C-r" 'ada-find-references)
+  (define-key ada-mode-map "\C-cl" 'ada-find-local-references)
   (define-key ada-mode-map "\C-c\C-v" 'ada-check-current)
-  (define-key ada-mode-map "\C-c\C-f" 'ada-find-file)
+  (define-key ada-mode-map "\C-cf" 'ada-find-file)
   )
 
 ;; ----- Menus --------------------------------------------------------------
@@ -564,6 +589,9 @@
 		 goto-menu ["List References" ada-find-references t]
 		 "Next compilation error")
 	(funcall (symbol-function 'add-menu-button)
+		 goto-menu ["List Local References" ada-find-local-references t]
+		 "Next compilation error")
+	(funcall (symbol-function 'add-menu-button)
 		 goto-menu ["Goto Declaration Other Frame"
 			    ada-goto-declaration-other-frame t]
 		 "Next compilation error")
@@ -620,11 +648,14 @@
 	)
     
     ;; for Emacs
-    (let* ((menu         (lookup-key ada-mode-map [menu-bar ada]))
-	   (edit-menu    (lookup-key ada-mode-map [menu-bar ada edit]))
-	   (help-menu    (lookup-key ada-mode-map [menu-bar ada help]))
-	   (goto-menu    (lookup-key ada-mode-map [menu-bar ada goto]))
-	   (options-menu (lookup-key ada-mode-map [menu-bar ada options])))
+    (let* ((menu      (or (lookup-key ada-mode-map [menu-bar Ada])
+			  ;; Emacs-21.4's easymenu.el downcases the events.
+			  (lookup-key ada-mode-map [menu-bar ada])))
+	   (edit-menu (or (lookup-key menu [Edit]) (lookup-key menu [edit])))
+	   (help-menu (or (lookup-key menu [Help]) (lookup-key menu [help])))
+	   (goto-menu (or (lookup-key menu [Goto]) (lookup-key menu [goto])))
+	   (options-menu (or (lookup-key menu [Options])
+			     (lookup-key menu [options]))))
 
       (define-key-after menu [Check] '("Check file" . ada-check-current)
 	'Customize)
@@ -656,6 +687,8 @@
 	'("Goto References to any entity" . ada-find-any-references))
       (define-key goto-menu [References]
 	'("List References" . ada-find-references))
+      (define-key goto-menu [Local-References]
+	'("List Local References" . ada-find-local-references))
       (define-key goto-menu [Prev]
 	'("Goto Previous Reference" . ada-xref-goto-previous-reference))
       (define-key goto-menu [Decl-other]
@@ -732,7 +765,7 @@
 (defun ada-set-default-project-file (name)
   "Set the file whose name is NAME as the default project file."
   (interactive "fProject file:")
-  (set 'ada-prj-default-project-file name)
+  (setq ada-prj-default-project-file name)
   (ada-reread-prj-file name)
   )
 
@@ -843,8 +876,12 @@
 	;;  find-file anyway, since the speedbar frame is special and does not
 	;;  allow the selection of a file in it.
 
-	(set-buffer (find-file-noselect prj-file))
-	
+	(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))
 
@@ -930,7 +967,7 @@
 	     (append (mapcar 'directory-file-name compilation-search-path)
 		     ada-search-directories))
 	
-	;; Kill the .ali buffer
+	;; Kill the project buffer
 	(kill-buffer nil)
 	(set-buffer ada-buffer)
 
@@ -946,12 +983,13 @@
     ))
       
     
-(defun ada-find-references (&optional pos)
+(defun ada-find-references (&optional pos arg local-only)
   "Find all references to the entity under POS.
-Calls gnatfind to find the references."
-  (interactive "")
-  (unless pos
-    (set 'pos (point)))
+Calls gnatfind to find the references.
+if ARG is t, the contents of the old *gnatfind* buffer is preserved.
+if LOCAL-ONLY is t, only the declarations in the current file are returned."
+  (interactive "d
+P")
   (ada-require-project-file)
 
   (let* ((identlist (ada-read-identifier pos))
@@ -965,16 +1003,29 @@
             (file-newer-than-file-p (ada-file-of identlist) alifile))
         (ada-find-any-references (ada-name-of identlist)
                                  (ada-file-of identlist)
-                                 nil nil)
+                                 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))))
+                               (ada-column-of identlist) local-only arg)))
   )
 
-(defun ada-find-any-references (entity &optional file line column)
+(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 t, the contents of the old *gnatfind* buffer is preserved."
+  (interactive "d
+P")
+  (ada-find-references pos arg t))
+
+(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."
+ENTITY was first found the location given by FILE, LINE and COLUMN.
+If LOCAL-ONLY is t, then only the references in file will be listed, which
+is much faster.
+If APPEND is t, then the output of the command will be append to the existing
+buffer *gnatfind* if it exists."
   (interactive "sEntity name: ")
   (ada-require-project-file)
 
@@ -992,19 +1043,33 @@
 			  quote-entity
                           (if file (concat ":" (file-name-nondirectory file)))
                           (if line (concat ":" line))
-                          (if column (concat ":" column)))))
+                          (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 "")))
         (setq command (concat command " -p" ada-prj-default-project-file)))
 
+    (if (and append (get-buffer "*gnatfind*"))
+	(save-excursion
+	  (set-buffer "*gnatfind*")
+	  (setq old-contents (buffer-string))))
+    
     (compile-internal command "No more references" "gnatfind")
 
     ;;  Hide the "Compilation" menu
     (save-excursion
       (set-buffer "*gnatfind*")
-      (local-unset-key [menu-bar compilation-menu]))
+      (local-unset-key [menu-bar compilation-menu])
+
+      (if old-contents
+	  (progn
+	    (goto-char 1)
+	    (insert old-contents)
+	    (goto-char (point-max)))))
     )
   )
 
@@ -1102,7 +1167,20 @@
   (let ((identlist (ada-read-identifier pos)))
     (condition-case nil
 	(ada-find-in-ali identlist other-frame)
-      (error (ada-find-in-src-path identlist other-frame)))))
+      (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. It might 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 &optional other-frame)
   "Display the declaration of the identifier around POS.
@@ -1647,7 +1725,7 @@
     (set 'identlist    (ada-make-identlist))
     (ada-set-name      identlist (downcase identifier))
     (ada-set-line      identlist
-		       (number-to-string (count-lines (point-min) (point))))
+		       (number-to-string (count-lines 1 (point))))
     (ada-set-column    identlist
 		       (number-to-string (1+ (current-column))))
     (ada-set-file      identlist (buffer-file-name))
@@ -1677,7 +1755,7 @@
 		(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))
 	  ))
@@ -1696,10 +1774,10 @@
        (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]+[^0-9][0-9]+\\(\n\\.\\)? \\)*"
 					 (ada-line-of identlist)
-					 "[^0-9]"
-					 (ada-column-of identlist))
+					 "[^etp]"
+					 (ada-column-of identlist) "\\>")
 				 nil t)
 
           ;; if we did not find it, it may be because the first reference
@@ -1707,10 +1785,12 @@
           ;; Or maybe we are already on the declaration...
           (unless (re-search-forward
 		   (concat
-		    "^\\(\\([a-zA-Z0-9_.]+\\|\"[<>=+*-/a-z]\"\\)[ *]\\)*"
+		    "^[0-9]+.[0-9]+[ *]"
+		    (ada-name-of identlist)
+		    "[ <{=\(]\\(.\\|\n\\.\\)*\\<"
 		    (ada-line-of identlist)
 		    "[^0-9]"
-		    (ada-column-of identlist))
+		    (ada-column-of identlist) "\\>")
 		   nil t)
 	    
 	    ;; If still not found, then either the declaration is unknown
@@ -1729,7 +1809,7 @@
 	    (while (looking-at "^\\.")
 	      (previous-line 1))
 	    (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
@@ -1802,7 +1882,7 @@
           (goto-char (point-max))
           (while (re-search-backward my-regexp nil t)
             (save-excursion
-              (set 'line-ali (count-lines (point-min) (point)))
+              (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]+\\)[ *]")
@@ -2291,11 +2371,6 @@
   ;; This should really be an `add-hook'.  -stef
   (setq ff-file-created-hooks 'ada-make-body-gnatstub)
 
-  ;; Read the project file and update the search path
-  ;; before looking for the other file
-  (make-local-hook 'ff-pre-find-hooks)
-  (add-hook 'ff-pre-find-hooks 'ada-require-project-file nil t)
-
   ;; Completion for file names in the mini buffer should ignore .ali files
   (add-to-list 'completion-ignored-extensions ".ali")
   )
@@ -2334,10 +2409,10 @@
 ;;  Make sure that the files are always associated with a project file. Since
 ;;  the project file has some fields that are used for the editor (like the
 ;;  casing exceptions), it has to be read before the user edits a file).
-(add-hook 'ada-mode-hook
-	  (lambda()
-	    (let ((file (ada-prj-find-prj-file t)))
-	      (if file (ada-reread-prj-file file)))))
+;; (add-hook 'ada-mode-hook
+;; 	  (lambda()
+;; 	    (let ((file (ada-prj-find-prj-file t)))
+;; 	      (if file (ada-reread-prj-file file)))))
 
 (provide 'ada-xref)