]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/etags.el
Update copyright notice.
[gnu-emacs] / lisp / progmodes / etags.el
index 5efd54a9867550ccf6811d09cf49f5a0c3230933..ed9959a1c02bc106c79b0dfc4c9c1e20ace36848 100644 (file)
@@ -1,4 +1,5 @@
 ;;; etags.el --- etags facility for Emacs
+
 ;; Copyright (C) 1985, 86, 88, 89, 92, 93, 94, 95, 96, 98, 2000, 2001
 ;;     Free Software Foundation, Inc.
 
@@ -28,7 +29,6 @@
 ;;; Code:
 
 (require 'ring)
-(eval-when-compile (require 'cl)) ; for `gensym'
 
 ;;;###autoload
 (defvar tags-file-name nil
@@ -69,19 +69,19 @@ Use the `etags' program to make a tags table file."
   "*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  'sexp ;;; what should be put here to have a list of strings ?
+\(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.
+;; !!! 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
@@ -832,7 +832,7 @@ or just \\[negative-argument]), pop back to the previous tag gone to.
 
 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.
 
@@ -904,7 +904,7 @@ or just \\[negative-argument]), pop back to the previous tag gone to.
 
 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.
 
@@ -931,7 +931,7 @@ just \\[negative-argument]), pop back to the previous tag gone to.
 
 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.
 
@@ -972,7 +972,7 @@ just \\[negative-argument]), pop back to the previous tag gone to.
 
 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.
 
@@ -995,7 +995,7 @@ just \\[negative-argument]), pop back to the previous tag gone to.
 
 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.
 
@@ -1030,12 +1030,12 @@ where they were found."
 ;; 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
@@ -1196,6 +1196,7 @@ where they were found."
               (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
@@ -1210,7 +1211,7 @@ where they were found."
 ;; 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
@@ -1254,7 +1255,7 @@ where they were found."
        ;; 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")
@@ -1336,7 +1337,7 @@ where they were found."
     (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")))
@@ -1361,7 +1362,7 @@ where they were found."
 
 (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))
@@ -1401,7 +1402,7 @@ where they were found."
     (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)
@@ -1461,7 +1462,7 @@ where they were found."
             (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)
@@ -1479,6 +1480,23 @@ where they were found."
 ;;       (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)
@@ -1488,6 +1506,17 @@ where they were found."
       ;; 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)
@@ -1503,27 +1532,10 @@ where they were found."
        (save-excursion (backward-char (length tag))
                       (looking-at "\\b"))))
 
-;;; 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 ",")
-       (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 ",")
-       (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 :).
-
-;;; partial file name match, i.e. searched tag must match a substring
-;;; of the file name (potentially including a directory separator).
+;; 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"))))
@@ -1721,30 +1733,27 @@ See documentation of variable `tags-file-name'."
           (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)
@@ -1753,10 +1762,8 @@ See documentation of variable `tags-file-name'."
     (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)
@@ -1802,7 +1809,7 @@ directory specification."
     (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
@@ -1844,7 +1851,7 @@ see the doc of that variable if you want to add names to the list."
       (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
@@ -1890,7 +1897,7 @@ see the doc of that variable if you want to add names to the list."
   (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.