(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'.

2 files changed, 166 insertions, 95 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f5928201fec..40621edea1c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,31 @@
+2003-04-04  Masatake YAMATO  <jet@gyve.org>
+
+        * progmodes/etags.el (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'.
+
 2003-04-04  Andreas Schwab  <schwab@suse.de>
 
         * net/tramp.el (tramp-send-string): Handle empty string.
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 471be32401a..f1f5e36c51e 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -222,13 +222,17 @@ until one returns non-nil.  The function should make buffer-local bindings
 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 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
         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 @@ where they were found."
 
       ;; 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 @@ where they were found."
   ;; 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 @@ where they were found."
                 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 @@ where they were found."
       (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 @@ where they were found."
 
 (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 @@ where they were found."
       (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 @@ where they were found."
   (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 @@ directory specification."
         (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)