* broken tags-apropos and list-tags
2003-04-03 11:51 ` Masatake YAMATO
@ 2003-04-03 17:40 ` Masatake YAMATO
2003-04-04 6:58 ` Richard Stallman
0 siblings, 1 reply; 7+ messages in thread
From: Masatake YAMATO @ 2003-04-03 17:40 UTC (permalink / raw)
(I'll do the describe-minor-mode issue after this etags ones. Because
etags.el is so buggy now. It shoule be fixed quickly for free software
developers.)
I fixed bugs in list-tag; and improved my tags-apropos patch.
- list-tag
M-x list-tag is broken. The reason is the same to tags-apropos;
new apropos-mode uses button instead of text properties directly.
I've updated M-x list-tag to make it work well with new apropos-mode.
- tags-apropos
I've used `find-file-of-tag' instead of `find-file'.
In the last patch I posted here, I used find-file directly. It is not
good for compressed files. I've followed the manner in `find-tag-in-order'.
`find-file-of-tag' is new function cut&past'ed from `find-tag-in-order'.
I made relative paths instead of complete path to show tags item.
With my last patch, lines in *Tags List* is too long like:
[/usr/src/linux/drivers/net/tokenring/smctr.c]: static int smctr_wait_while_cbusy(
[/usr/src/linux/drivers/char/drm/drm.h]: _DRM_DMA_WHILE_LOCKED
[/usr/src/linux/drivers/char/drm/drm.h]: _DRM_DMA_WHILE_LOCKED = 0x02,
[/usr/src/linux/drivers/char/drm-4.0/drm.h]: _DRM_DMA_WHILE_LOCKED
With new patch, it looks like:
[drivers/net/tokenring/smctr.c]: static int smctr_wait_while_cbusy(
[drivers/char/drm/drm.h]: _DRM_DMA_WHILE_LOCKED
[drivers/char/drm/drm.h]: _DRM_DMA_WHILE_LOCKED = 0x02,
[drivers/char/drm-4.0/drm.h]: _DRM_DMA_WHILE_LOCKED
Much easier to read.
- apropos-additional
etags-tags-apropos-additional runs in tags-apropos is also broken.
The reason is the same to tags-apropos; new apropos-mode uses button
instead of text properties directly. I've updated. However, there is
a still problem. I'll explain below.
- modification common for above updating
To archive above updating, I added an optional argument to
snarf-tag-function and etags-file-of-tag.
- problem of apropos-additional
Even with or without my patch, etags-tags-apropos-additional will not
work well with the example explained in the doc of `tags-apropos-additional-actions':
(("Emacs Lisp" Info-goto-emacs-command-node obarray)
("Common Lisp" common-lisp-hyperspec common-lisp-hyperspec-obarray)
("SCWM" scwm-documentation scwm-obarray))
Here, I focused on Info-goto-emacs-command-node. This function takes
a symbol as its argument. However, the implementation of
`etags-tags-apropos-additional' passed a string Info-goto-emacs-command-node.
I believe etags-tags-apropos-additional should pass a string.
So the example shoule be fixed like:
(("Emacs Lisp"
(lambda (cmd) (Info-goto-emacs-command-node (intern cmd) obarray))
obarray)
...)
Masatake YAMATO
2003-04-04 Masatake YAMATO <jet@gyve.org>
[Common]
* progmodes/etags.el (find-file-of-tag-noselect): New helper function.
(find-file-of-tag): New helper function.
(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`.
[Fixing list-tags]
(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'.
[Fixing tags-apropos]
(etags-tags-apropos): Used `find-file-of-tag-noselect' instead of
`find-file'. Do not use `etags-goto-tag-location` directly. Instead,
Used `goto-tag-location-function'. Print relative file paths instead
of complete ones in *Tags List* buffer. So each lines in the buffer
become short.
[Fixing apropos-additional]
(etags-tags-apropos-additional): Use `make-text-button' instead of
`add-text-properties'.
Index: lisp/progmodes/etags.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/progmodes/etags.el,v
retrieving revision 1.172
diff -u -r1.172 etags.el
--- lisp/progmodes/etags.el 3 Apr 2003 15:55:37 -0000 1.172
+++ lisp/progmodes/etags.el 3 Apr 2003 17:38:46 -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))
\f
-(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,42 +1149,16 @@
;; 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)))))
\f
;; `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)
^ permalink raw reply [flat|nested] 7+ messages in thread