mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-05 19:31:02 -08:00
(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'.
This commit is contained in:
Juanma Barranquero
parent
a9b4949e2d
commit
79e01623a7
2 changed files with 166 additions and 95 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue