Mercurial > emacs

changeset 50435:2c804de1a942

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(find-file-of-tag-noselect, find-file-of-tag): New helper functions. (snarf-tag-function): Doc string is changed. Explained about new optional argument, `use-explicit'. (etags-snarf-tag): Added one optional argument `use-explicit'. (file-of-tag-function): Doc string is changed. Explained about new optional argument, `relative'. (file-of-tag): Doc string is changed. Explained about new optional argument, `relative'. Pass `relative' to `file-of-tag-function'. (etags-file-of-tag): Added new argument `relative`. (list-tags): Set `buffer-read-only' to t after making the major mode apropos-mode. (etags-list-tags): Used `make-text-button' instead of `add-text-properties'. Used `snarf-tag-function', `goto-tag-location-function' and `find-file-of-tag' instead of `find-tag-other-window' (it's too simple). (find-tag-in-order): Used `find-file-of-tag-noselect' instead of `find-file'. (etags-tags-apropos): Used `find-file-of-tag-noselect' instead of `find-file'. Do not use `etags-goto-tag-location` directly; use `goto-tag-location-function' instead. Print relative file paths instead of complete ones in *Tags List* buffer, so lines in the buffer become shorter. (etags-tags-apropos-additional): Use `make-text-button' instead of `add-text-properties'.
author Juanma Barranquero <lekktu@gmail.com>
date Fri, 04 Apr 2003 20:01:36 +0000
parents 4e1981de74ae
children 0538658c405e
files lisp/progmodes/etags.el
diffstat 1 files changed, 138 insertions(+), 95 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/progmodes/etags.el	Fri Apr 04 17:24:46 2003 +0000
+++ b/lisp/progmodes/etags.el	Fri Apr 04 20:01:36 2003 +0000
@@ -222,13 +222,17 @@
 of the format-parsing tags function variables if successful.")
 
 (defvar file-of-tag-function nil
-  "Function to do the work of `file-of-tag' (which see).")
+  "Function to do the work of `file-of-tag' (which see).
+One optional argument, a boolean specifying to return complete path (nil) or
+relative path (non-nil).")
 (defvar tags-table-files-function nil
   "Function to do the work of `tags-table-files' (which see).")
 (defvar tags-completion-table-function nil
   "Function to build the `tags-completion-table'.")
 (defvar snarf-tag-function nil
-  "Function to get info about a matched tag for `goto-tag-location-function'.")
+  "Function to get info about a matched tag for `goto-tag-location-function'.
+One optional argument, specifying to use explicit tag (non-nil) or not (nil).
+The default is nil.")
 (defvar goto-tag-location-function nil
   "Function of to go to the location in the buffer specified by a tag.
 One argument, the tag info returned by `snarf-tag-function'.")
@@ -703,11 +707,13 @@
 	tags-table-list-started-at nil
 	tags-table-set-list nil))
 
-(defun file-of-tag ()
+(defun file-of-tag (&optional relative)
   "Return the file name of the file whose tags point is within.
 Assumes the tags table is the current buffer.
-File name returned is relative to tags table file's directory."
-  (funcall file-of-tag-function))
+If RELATIVE is non-nil, file name returned is relative to tags
+table file's directory. If RELATIVE is nil, file name returned
+is complete."
+  (funcall file-of-tag-function relative))
 
 ;;;###autoload
 (defun tags-table-files ()
@@ -1143,45 +1149,53 @@
 
       ;; Get the local value in the tags table buffer before switching buffers.
       (setq goto-func goto-tag-location-function)
-
-      ;; Find the right line in the specified file.
-      ;; If we are interested in compressed-files,
-      ;; we search files with extensions.
-      ;; otherwise only the real file.
-      (let* ((buffer-search-extensions (if (featurep 'jka-compr)
-                                           tags-compression-info-list
-                                         '("")))
-             the-buffer
-             (file-search-extensions buffer-search-extensions))
-	;; search a buffer visiting the file with each possible extension
-	;; Note: there is a small inefficiency in find-buffer-visiting :
-	;;   truename is computed even if not needed. Not too sure about this
-	;;   but I suspect truename computation accesses the disk.
-	;;   It is maybe a good idea to optimise this find-buffer-visiting.
-	;; An alternative would be to use only get-file-buffer
-	;; but this looks less "sure" to find the buffer for the file.
-	(while (and (not the-buffer) buffer-search-extensions)
-	  (setq the-buffer (find-buffer-visiting (concat file (car buffer-search-extensions))))
-	  (setq buffer-search-extensions (cdr buffer-search-extensions)))
-	;; if found a buffer but file modified, ensure we re-read !
-	(if (and the-buffer (not (verify-visited-file-modtime the-buffer)))
-	    (find-file-noselect (buffer-file-name the-buffer)))
-	;; if no buffer found, search for files with possible extensions on disk
-	(while (and (not the-buffer) file-search-extensions)
-	  (if (not (file-exists-p (concat file (car file-search-extensions))))
-	      (setq file-search-extensions (cdr file-search-extensions))
-	    (setq the-buffer (find-file-noselect (concat file (car file-search-extensions))))))
-	(if (not the-buffer)
-	    (if (featurep 'jka-compr)
-		(error "File %s (with or without extensions %s) not found" file tags-compression-info-list)
-	      (error "File %s not found" file))
-	  (set-buffer the-buffer)))
+      (find-file-of-tag-noselect file)
       (widen)
       (push-mark)
       (funcall goto-func tag-info)
 
       ;; Return the buffer where the tag was found.
       (current-buffer))))
+
+(defun find-file-of-tag-noselect (file)
+  ;; Find the right line in the specified file.
+  ;; If we are interested in compressed-files,
+  ;; we search files with extensions.
+  ;; otherwise only the real file.
+  (let* ((buffer-search-extensions (if (featurep 'jka-compr)
+				       tags-compression-info-list
+				     '("")))
+	 the-buffer
+	 (file-search-extensions buffer-search-extensions))
+    ;; search a buffer visiting the file with each possible extension
+    ;; Note: there is a small inefficiency in find-buffer-visiting :
+    ;;   truename is computed even if not needed. Not too sure about this
+    ;;   but I suspect truename computation accesses the disk.
+    ;;   It is maybe a good idea to optimise this find-buffer-visiting.
+    ;; An alternative would be to use only get-file-buffer
+    ;; but this looks less "sure" to find the buffer for the file.
+    (while (and (not the-buffer) buffer-search-extensions)
+      (setq the-buffer (find-buffer-visiting (concat file (car buffer-search-extensions))))
+      (setq buffer-search-extensions (cdr buffer-search-extensions)))
+    ;; if found a buffer but file modified, ensure we re-read !
+    (if (and the-buffer (not (verify-visited-file-modtime the-buffer)))
+	(find-file-noselect (buffer-file-name the-buffer)))
+    ;; if no buffer found, search for files with possible extensions on disk
+    (while (and (not the-buffer) file-search-extensions)
+      (if (not (file-exists-p (concat file (car file-search-extensions))))
+	  (setq file-search-extensions (cdr file-search-extensions))
+	(setq the-buffer (find-file-noselect (concat file (car file-search-extensions))))))
+    (if (not the-buffer)
+	(if (featurep 'jka-compr)
+	    (error "File %s (with or without extensions %s) not found" file tags-compression-info-list)
+	  (error "File %s not found" file))
+      (set-buffer the-buffer))))
+
+(defun find-file-of-tag (file)
+  (let ((buf (find-file-of-tag-noselect file)))
+    (condition-case nil
+	(switch-to-buffer buf)
+      (error (pop-to-buffer buf)))))
 
 ;; `etags' TAGS file format support.
 
@@ -1222,11 +1236,14 @@
   ;; Use eq instead of = in case char-after returns nil.
   (eq (char-after (point-min)) ?\f))
 
-(defun etags-file-of-tag ()
+(defun etags-file-of-tag (&optional relative)
   (save-excursion
     (re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n")
-    (expand-file-name (buffer-substring (match-beginning 1) (match-end 1))
-		      (file-truename default-directory))))
+    (let ((str (buffer-substring (match-beginning 1) (match-end 1))))
+      (if relative
+	  str
+	(expand-file-name str
+			  (file-truename default-directory))))))
 
 
 (defun etags-tags-completion-table ()
@@ -1254,8 +1271,8 @@
 		table)))
     table))
 
-(defun etags-snarf-tag ()
-  (let (tag-text line startpos)
+(defun etags-snarf-tag (&optional use-explicit)
+  (let (tag-text line startpos explicit-start)
     (if (save-excursion
 	  (forward-line -1)
 	  (looking-at "\f\n"))
@@ -1271,8 +1288,14 @@
       (setq tag-text (buffer-substring (1- (point))
 				       (save-excursion (beginning-of-line)
 						       (point))))
-      ;; Skip explicit tag name if present.
-      (search-forward "\001" (save-excursion (forward-line 1) (point)) t)
+      ;; If use-explicit is non nil and explicit tag is present, use it as part of
+      ;; return value. Else just skip it.
+      (setq explicit-start (point))
+      (when (and (search-forward "\001" (save-excursion (forward-line 1) (point)) t)
+		 use-explicit)
+	(setq tag-text (buffer-substring explicit-start (1- (point)))))
+
+
       (if (looking-at "[0-9]")
 	  (setq line (string-to-int (buffer-substring
 				     (point)
@@ -1347,27 +1370,35 @@
 
 (defun etags-list-tags (file)
   (goto-char (point-min))
-  (when (search-forward (concat "\f\n" file ",") nil t)
+  (when (re-search-forward (concat "\f\n" "\\(" file "\\)" ",") nil t)
+    (let ((path (save-excursion (forward-line 1) (file-of-tag)))
+	  ;; Get the local value in the tags table
+	  ;; buffer before switching buffers.
+	  (goto-func goto-tag-location-function)
+	  tag tag-info pt)
     (forward-line 1)
     (while (not (or (eobp) (looking-at "\f")))
-      (let ((tag (buffer-substring (point)
-				   (progn (skip-chars-forward "^\177")
-					  (point))))
-            (props `(action find-tag-other-window mouse-face highlight
-			    face ,tags-tag-face))
-            (pt (with-current-buffer standard-output (point))))
-        (when (looking-at "[^\n]+\001")
-	  ;; There is an explicit tag name; use that.
-          (setq tag (buffer-substring (1+ (point)) ; skip \177
-				      (progn (skip-chars-forward "^\001")
-                                             (point)))))
-        (princ tag)
-        (when (= (aref tag 0) ?\() (princ " ...)"))
-        (add-text-properties pt (with-current-buffer standard-output (point))
-                             (cons 'item (cons tag props)) standard-output))
+      (setq tag-info (save-excursion (funcall snarf-tag-function t))
+	    tag (car tag-info)
+	    pt (with-current-buffer standard-output (point)))
+      (princ tag)
+      (when (= (aref tag 0) ?\() (princ " ...)"))
+      (with-current-buffer standard-output
+	(make-text-button pt (point)
+			  'tag-info tag-info
+			  'file-path path
+			  'goto-func goto-func
+			  'action (lambda (button)
+				    (let ((tag-info (button-get button 'tag-info))
+					  (goto-func (button-get button 'goto-func)))
+				      (find-file-of-tag (button-get button 'file-path))
+				      (widen)
+				      (funcall goto-func tag-info)))
+			  'face 'tags-tag-face
+			  'type 'button))
       (terpri)
       (forward-line 1))
-    t))
+    t)))
 
 (defmacro tags-with-face (face &rest body)
   "Execute BODY, give output to `standard-output' face FACE."
@@ -1384,16 +1415,20 @@
       (princ "\n\n")
       (tags-with-face 'highlight (princ (car oba)))
       (princ":\n\n")
-      (let* ((props `(action ,(cadr oba) mouse-face highlight face
-			     ,tags-tag-face))
-             (beg (point))
+      (let* ((beg (point))
 	     (symbs (car (cddr oba)))
              (ins-symb (lambda (sy)
                          (let ((sn (symbol-name sy)))
                            (when (string-match regexp sn)
-                             (add-text-properties (point)
-						  (progn (princ sy) (point))
-						  (cons 'item (cons sn props)))
+                             (make-text-button (point)
+					  (progn (princ sy) (point))
+					  'action-internal(cadr oba)
+					  'action (lambda (button) (funcall
+								    (button-get button 'action-internal)
+								    (button-get button 'item)))
+					  'item sn
+					  'face tags-tag-face
+					  'type 'button)
                              (terpri))))))
         (when (symbolp symbs)
           (if (boundp symbs)
@@ -1414,40 +1449,48 @@
   (goto-char (point-min))
   (while (re-search-forward string nil t)
     (beginning-of-line)
-    (let* ((tag-info (save-excursion (funcall snarf-tag-function)))
+
+    (let* (;; Get the local value in the tags table
+	   ;; buffer before switching buffers.
+	   (goto-func goto-tag-location-function)
+	   (tag-info (save-excursion (funcall snarf-tag-function)))
 	   (tag (if (eq t (car tag-info)) nil (car tag-info)))
-	   (file (if tag (file-of-tag)
-		   (save-excursion (next-line 1)
-				   (file-of-tag))))
+	   (file-path (save-excursion (if tag (file-of-tag)
+					(save-excursion (next-line 1)
+							(file-of-tag)))))
+	   (file-label (if tag (file-of-tag t)
+			 (save-excursion (next-line 1)
+					 (file-of-tag t))))
 	   (pt (with-current-buffer standard-output (point))))
       (if tag
 	  (progn
-	    (princ (format "[%s]: " file))
+	    (princ (format "[%s]: " file-label))
 	    (princ tag)
 	    (when (= (aref tag 0) ?\() (princ " ...)"))
 	    (with-current-buffer standard-output
-	    (make-text-button pt (point)
-			      'tag-info tag-info
-			      'file file
-			      'action (lambda (button)
-					;; TODO: just `find-file is too simple.
-					;; Use code `find-tag-in-order'.
-					(let ((tag-info (button-get button 'tag-info)))
-					  (find-file (button-get button 'file))
-					  (etags-goto-tag-location tag-info)))
-			      'face 'tags-tag-face
-			      'type 'button)))
-	(princ (format "- %s" file))
+	      (make-text-button pt (point)
+				'tag-info tag-info
+				'file-path file-path
+				'goto-func goto-func
+				'action (lambda (button)
+					  (let ((tag-info (button-get button 'tag-info))
+						(goto-func (button-get button 'goto-func)))
+					    (find-file-of-tag (button-get button 'file-path))
+					    (widen)
+					    (funcall goto-func tag-info)))
+				'face 'tags-tag-face
+				'type 'button)))
+	(princ (format "- %s" file-label))
 	(with-current-buffer standard-output
 	  (make-text-button pt (point)
-	  'file file
-	  'action (lambda (button)
-		    ;; TODO: just `find-file is too simple.
-		    ;; Use code `find-tag-in-order'.
-		    (find-file (button-get button 'file))
-		    (goto-char (point-min)))
-	  'face 'tags-tag-face
-	  'type 'button))
+			    'file-path file-path
+			    'action (lambda (button)
+				      (find-file-of-tag (button-get button 'file-path))
+				      ;; Get the local value in the tags table
+				      ;; buffer before switching buffers.
+				      (goto-char (point-min)))
+			    'face 'tags-tag-face
+			    'type 'button))
 	))
     (terpri)
     (forward-line 1))
@@ -1822,8 +1865,8 @@
 	(or gotany
 	    (error "File %s not in current tags tables" file)))))
   (with-current-buffer "*Tags List*"
-    (setq buffer-read-only t)
-    (apropos-mode)))
+    (apropos-mode)
+    (setq buffer-read-only t)))
 
 ;;;###autoload
 (defun tags-apropos (regexp)