;;; etags.el --- etags facility for Emacs
-;; Copyright (C) 1985, 86, 88, 89, 92, 93, 94, 95, 96, 98, 2000
+
+;; Copyright (C) 1985, 86, 88, 89, 92, 93, 94, 95, 96, 98, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;;; Code:
(require 'ring)
-(eval-when-compile (require 'cl)) ; for `gensym'
;;;###autoload
(defvar tags-file-name nil
:group 'etags
:type '(repeat file))
+;;;###autoload
+(defcustom tags-compression-info-list '("" ".Z" ".bz2" ".gz" ".tgz")
+ "*List of extensions tried by etags when jka-compr is used.
+An empty string means search the non-compressed file.
+These extensions will be tried only if jka-compr was activated
+\(i.e. via customize of `auto-compression-mode' or by calling the function
+`auto-compression-mode')."
+ :type '(repeat string)
+ :group 'etags)
+
+;; !!! tags-compression-info-list should probably be replaced by access
+;; to directory list and matching jka-compr-compression-info-list. Currently,
+;; this implementation forces each modification of
+;; jka-compr-compression-info-list to be reflected in this var.
+;; An alternative could be to say that introducing a special
+;; element in this list (e.g. t) means : try at this point
+;; using directory listing and regexp matching using
+;; jka-compr-compression-info-list.
+
+
;;;###autoload
(defcustom tags-add-tables 'ask-user
"*Control whether to add a new tags table to the current list.
has a `find-tag-default-function' property (see `put'), that is used.
Otherwise, `find-tag-default' is used."
:group 'etags
- :type 'function)
+ :type '(choice (const nil) function))
(defcustom find-tag-marker-ring-length 16
"*Length of marker rings `find-tag-marker-ring' and `tags-location-ring'."
If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
-A marker representing the point when this command is onvoked is pushed
+A marker representing the point when this command is invoked is pushed
onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
;; Save the current buffer's value of `find-tag-hook' before
;; selecting the tags table buffer. For the same reason, save value
;; of `tags-file-name' in case it has a buffer-local value.
- (let ((local-find-tag-hook find-tag-hook)
- (tags-file-name tags-file-name))
+ (let ((local-find-tag-hook find-tag-hook))
(if (eq '- next-p)
;; Pop back to a previous location.
(if (ring-empty-p tags-location-ring)
If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
-A marker representing the point when this command is onvoked is pushed
+A marker representing the point when this command is invoked is pushed
onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
-A marker representing the point when this command is onvoked is pushed
+A marker representing the point when this command is invoked is pushed
onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
-A marker representing the point when this command is onvoked is pushed
+A marker representing the point when this command is invoked is pushed
onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
If third arg OTHER-WINDOW is non-nil, select the buffer in another window.
-A marker representing the point when this command is onvoked is pushed
+A marker representing the point when this command is invoked is pushed
onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
;; any member of the function list ORDER (third arg). If ORDER is nil,
;; use saved state to continue a previous search.
-;; Fourth arg MATCHING is a string, an English '-ing' word, to be used in
-;; an error message.
-
-;; Fifth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
+;; Fourth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
;; point should be moved to the next line.
+;; Fifth arg MATCHING is a string, an English '-ing' word, to be used in
+;; an error message.
+
;; Algorithm is as follows. For each qualifier-func in ORDER, go to
;; beginning of tags file, and perform inner loop: for each naive match for
;; PATTERN found using SEARCH-FORWARD-FUNC, qualify the naive match using
tag-lines-already-matched))
;; Expand the filename, using the tags table buffer's default-directory.
;; We should be able to search for file-name backwards in file-of-tag:
- ;; the beginning-of-line is ok except when positionned on a "file-name" tag.
+ ;; the beginning-of-line is ok except when positioned on a "file-name" tag.
(setq file (expand-file-name
- (if (or (eq (car order) 'tag-exact-file-name-match-p)
- (eq (car order) 'tag-partial-file-name-match-p))
+ (if (memq (car order) '(tag-exact-file-name-match-p
+ tag-file-name-match-p
+ tag-partial-file-name-match-p))
(save-excursion (next-line 1)
(file-of-tag))
(file-of-tag)))
(setq goto-func goto-tag-location-function)
;; Find the right line in the specified file.
- (set-buffer (find-file-noselect 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)))
(widen)
(push-mark)
(funcall goto-func tag-info)
(find-tag-regexp-next-line-after-failure-p . t)
(find-tag-search-function . search-forward)
(find-tag-tag-order . (tag-exact-file-name-match-p
+ tag-file-name-match-p
tag-exact-match-p
+ tag-implicit-name-match-p
tag-symbol-match-p
tag-word-match-p
tag-partial-file-name-match-p
;; Return non-nil iff the current buffer is a valid etags TAGS file.
(defun etags-verify-tags-table ()
;; Use eq instead of = in case char-after returns nil.
- (eq (char-after 1) ?\f))
+ (eq (char-after (point-min)) ?\f))
(defun etags-file-of-tag ()
(save-excursion
;; the beginning of the file.
(setq tag-text t
line nil
- startpos 1)
+ startpos (point-min))
;; Find the end of the tag and record the whole tag text.
(search-forward "\177")
(beginning-of-line)))
(defun etags-list-tags (file)
- (goto-char 1)
+ (goto-char (point-min))
(when (search-forward (concat "\f\n" file ",") nil t)
(forward-line 1)
(while (not (or (eobp) (looking-at "\f")))
(defmacro tags-with-face (face &rest body)
"Execute BODY, give output to `standard-output' face FACE."
- (let ((pp (gensym "twf-")))
+ (let ((pp (make-symbol "start")))
`(let ((,pp (with-current-buffer standard-output (point))))
,@body
(put-text-property ,pp (with-current-buffer standard-output (point))
(princ "Tags in file `")
(tags-with-face 'highlight (princ buffer-file-name))
(princ "':\n\n"))
- (goto-char 1)
+ (goto-char (point-min))
(while (re-search-forward string nil t)
(beginning-of-line)
(let ((tag (buffer-substring (point)
(lambda () (zerop (buffer-size))))))
\f
;; Match qualifier functions for tagnames.
-;; XXX these functions assume etags file format.
+;; These functions assume the etags file format defined in etc/ETAGS.EBNF.
;; This might be a neat idea, but it's too hairy at the moment.
;;(defmacro tags-with-syntax (&rest body)
;; (set-syntax-table otable))))
;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form))
+;; exact file name match, i.e. searched tag must match complete file
+;; name including directories parts if there are some.
+(defun tag-exact-file-name-match-p (tag)
+ (and (looking-at ",[0-9\n]")
+ (save-excursion (backward-char (+ 2 (length tag)))
+ (looking-at "\f\n"))))
+;; file name match as above, but searched tag must match the file
+;; name not including the directories if there are some.
+(defun tag-file-name-match-p (tag)
+ (and (looking-at ",[0-9\n]")
+ (save-excursion (backward-char (1+ (length tag)))
+ (looking-at "/"))))
+;; this / to detect we are after a directory separator is ok for unix,
+;; is there a variable that contains the regexp for directory separator
+;; on whatever operating system ?
+;; Looks like ms-win will lose here :).
+
;; t if point is at a tag line that matches TAG exactly.
;; point should be just after a string that matches TAG.
(defun tag-exact-match-p (tag)
;; We are not on the explicit tag name, but perhaps it follows.
(looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001"))))
+;; t if point is at a tag line that has an implicit name.
+;; point should be just after a string that matches TAG.
+(defun tag-implicit-name-match-p (tag)
+ ;; Look at the comment of the make_tag function in lib-src/etags.c for
+ ;; a textual description of the four rules.
+ (and (string-match "^[^ \t()=,;]+$" tag) ;rule #1
+ (looking-at "[ \t()=,;]?\177") ;rules #2 and #4
+ (save-excursion
+ (backward-char (1+ (length tag)))
+ (looking-at "[\n \t()=,;]")))) ;rule #3
+
;; t if point is at a tag line that matches TAG as a symbol.
;; point should be just after a string that matches TAG.
(defun tag-symbol-match-p (tag)
(save-excursion (backward-char (length tag))
(looking-at "\\b"))))
-(defun tag-exact-file-name-match-p (tag)
- (and (looking-at ",")
- (save-excursion (backward-char (+ 2 (length tag)))
- (looking-at "\f\n"))))
+;; partial file name match, i.e. searched tag must match a substring
+;; of the file name (potentially including a directory separator).
(defun tag-partial-file-name-match-p (tag)
- (and (looking-at ".*,")
+ (and (looking-at ".*,[0-9\n]")
(save-excursion (beginning-of-line)
(backward-char 2)
(looking-at "\f\n"))))
tags-case-fold-search
case-fold-search)))
(eval form)))
-
+
;;;###autoload
(defun tags-loop-continue (&optional first-time)
;; Non-nil means we have finished one file
;; and should not scan it again.
file-finished
+ original-point
(messaged nil))
(while
(progn
;; Scan files quickly for the first or next interesting one.
+ ;; This starts at point in the current buffer.
(while (or first-time file-finished
(save-restriction
(widen)
(not (tags-loop-eval tags-loop-scan))))
+ ;; If nothing was found in the previous file, and
+ ;; that file isn't in a temp buffer, restore point to
+ ;; where it was.
+ (when original-point
+ (goto-char original-point))
+
(setq file-finished nil)
(setq new (next-file first-time t))
+
;; If NEW is non-nil, we got a temp buffer,
;; and NEW is the file name.
- (if (or messaged
- (and (not first-time)
- (> baud-rate search-slow-speed)
- (setq messaged t)))
- (message "Scanning file %s..." (or new buffer-file-name)))
+ (when (or messaged
+ (and (not first-time)
+ (> baud-rate search-slow-speed)
+ (setq messaged t)))
+ (message "Scanning file %s..." (or new buffer-file-name)))
+
(setq first-time nil)
+ (setq original-point (if new nil (point)))
(goto-char (point-min)))
;; If we visited it in a temp buffer, visit it now for real.
(set-buffer (find-file-noselect new))
(setq new nil) ;No longer in a temp buffer.
(widen)
- (goto-char pos)))
+ (goto-char pos))
+ (push-mark original-point t))
(switch-to-buffer (current-buffer))
(null tags-loop-operate))
;; Continue last tags-search as if by M-,.
(tags-loop-continue nil)
- (setq tags-loop-scan
- (list 're-search-forward (list 'quote regexp) nil t)
+ (setq tags-loop-scan `(re-search-forward ',regexp nil t)
tags-loop-operate nil)
(tags-loop-continue (or file-list-form t))))
;;;###autoload
(defun tags-query-replace (from to &optional delimited file-list-form start end)
- "`Query-replace-regexp' FROM with TO through all files listed in tags table.
+ "Do `query-replace-regexp' of FROM with TO on all files listed in tags table.
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
-If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
+If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
with the command \\[tags-loop-continue].
See documentation of variable `tags-file-name'."
- (interactive (query-replace-read-args "Tags query replace (regexp)" t))
- (setq tags-loop-scan (list 'prog1
- (list 'if (list 're-search-forward
- (list 'quote from) nil t)
- ;; When we find a match, move back
- ;; to the beginning of it so perform-replace
- ;; will see it.
- '(goto-char (match-beginning 0))))
- tags-loop-operate (list 'perform-replace
- (list 'quote from) (list 'quote to) nil nil
- t t (list 'quote delimited)))
+ (interactive (query-replace-read-args "Tags query replace (regexp)" t t))
+ (setq tags-loop-scan `(let ,(unless (equal from (downcase from))
+ '((case-fold-search nil)))
+ (if (re-search-forward ',from nil t)
+ ;; When we find a match, move back
+ ;; to the beginning of it so perform-replace
+ ;; will see it.
+ (goto-char (match-beginning 0))))
+ tags-loop-operate `(perform-replace ',from ',to t t ',delimited))
(tags-loop-continue (or file-list-form t)))
\f
(defun tags-complete-tags-table-file (string predicate what)
(let ((enable-recursive-minibuffers t))
(visit-tags-table-buffer))
(if (eq what t)
- (all-completions string (mapcar 'list (tags-table-files))
- predicate)
- (try-completion string (mapcar 'list (tags-table-files))
- predicate))))
+ (all-completions string (tags-table-files) predicate)
+ (try-completion string (tags-table-files) predicate))))
;;;###autoload
(defun list-tags (file &optional next-match)
(setq buffer-read-only t)
(apropos-mode)))
\f
-;;; XXX Kludge interface.
+;; XXX Kludge interface.
;; XXX If a file is in multiple tables, selection may get the wrong one.
;;;###autoload
(prin1 (car set-list) (current-buffer)) ;invisible
(insert "\n")
(setq set-list (delete (car set-list) set-list)))
- (goto-char 1)
+ (goto-char (point-min))
(insert-before-markers
"Type `t' to select a tags table or set of tags tables:\n\n")
(if desired-point
(interactive)
(quit-window t (selected-window)))
\f
-;;; Note, there is another definition of this function in bindings.el.
+;; Note, there is another definition of this function in bindings.el.
;;;###autoload
(defun complete-tag ()
"Perform tags completion on the text around point.