;;; etags.el --- etags facility for Emacs
-;; Copyright 1985, 1986, 1988, 1990, 1997 Free Software Foundation, Inc.
+;; Copyright 1985, 1986, 1988, 1990, 1997, 2003 Free Software Foundation, Inc.
;; Author: Their Name is Legion (see list below)
;; Maintainer: XEmacs Development Team
:type 'boolean
:group 'etags)
+(defcustom tags-check-parent-directories-for-tag-files t
+ "*If non-nil, look for TAGS files in all parent directories."
+ :type 'boolean
+ :group 'etags)
+
+(defcustom tags-exuberant-ctags-optimization-p nil
+ "*If this variable is nil (the default), then exact tag search is able
+to find tag names in the name part of the tagtable (enclosed by ^?..^A)
+and in the sourceline part of the tagtable ( enclosed by ^..^?).
+This is needed by xemacs etags as not every tag has a name field.
+It is slower for large tables and less precise than the other option.
+
+If it is non-nil, then exact tag will only search tag names in the name
+part (enclosed by ^?..^A). This is faster and more precise than the other
+option. This is only usable with exuberant etags, as it has a name field
+entry for every tag."
+:type 'boolean
+:group 'etags)
\f
;; Buffer tag tables.
;; Current directory
(when (file-readable-p (concat default-directory "TAGS"))
(push (concat default-directory "TAGS") result))
- ;; Parent directory
- (let ((parent-tag-file (expand-file-name "../TAGS" default-directory)))
- (when (file-readable-p parent-tag-file)
- (push parent-tag-file result)))
+ ;; Parent directories
+ (when tags-check-parent-directories-for-tag-files
+ (let ((cur default-directory))
+ ;; Fuck! Shouldn't there be a more obvious portable way
+ ;; to determine if we're the root? Shouldn't we have a
+ ;; proper path manipulation API? Do you know how many
+ ;; god-damn bugs are lurking out there because of Unix/
+ ;; Windows differences? And how much code is littered
+ ;; with stuff such as 10 lines down from here?
+ (while (not (and (equal (file-name-as-directory cur) cur)
+ (equal (directory-file-name cur) cur)))
+ (setq cur (expand-file-name ".." cur))
+ (let ((parent-tag-file (expand-file-name "TAGS" cur)))
+ (when (file-readable-p parent-tag-file)
+ (push parent-tag-file result))))))
;; tag-table-alist
- (let ((key (or buffer-file-name
- (concat default-directory (buffer-name))))
- expression)
+ (let* ((key (or buffer-file-name
+ (concat default-directory (buffer-name))))
+ (key (if (eq system-type 'windows-nt)
+ (replace-in-string key "\\\\" "/")
+ key))
+ expression)
(dolist (item tag-table-alist)
(setq expression (car item))
;; If the car of the alist item is a string, apply it as a regexp
(if (stringp expression)
(push expression result)
(error "Expression in tag-table-alist evaluated to non-string")))))
- (setq result
- (mapcar
- (lambda (name)
- (when (file-directory-p name)
- (setq name (concat (file-name-as-directory name) "TAGS")))
- (and (file-readable-p name)
- ;; get-tag-table-buffer has side-effects
- (symbol-value-in-buffer 'buffer-file-name
- (get-tag-table-buffer name))))
- result))
+ (setq result (buffer-tag-table-list-load result))
(setq result (delq nil result))
;; If no TAGS file has been found, ask the user explicitly.
;; #### tags-file-name is *evil*.
(or result tags-file-name
(call-interactively 'visit-tags-table))
(when tags-file-name
- (setq result (nconc result (list tags-file-name))))
+ (setq result (nconc result (buffer-tag-table-list-load (list tags-file-name)))))
(or result (error "Buffer has no associated tag tables"))
(delete-duplicates (nreverse result) :test 'equal)))
+(defun buffer-tag-table-list-load (list &optional used-buffers)
+ "Load all tag buffers in LIST. Include directives inside the tag
+Buffers result in a recursive call off this function. The USED-BUFFERS
+parameter is just for internal use and prevents infinite inclusion
+loops. The return value is a list of loaded buffers with the order
+from LIST preserved. The tag files loaded with the include directive
+are inserted into the returned list before their parents."
+ (let (result)
+ (and list
+ (mapc
+ #'(lambda (name)
+ (when (file-directory-p name)
+ (setq name (concat (file-name-as-directory name) "TAGS")))
+ (and
+ (file-readable-p name)
+ (save-excursion
+ (set-buffer (get-tag-table-buffer name))
+ (when (not (member buffer-file-name used-buffers))
+ (add-to-list 'used-buffers buffer-file-name)
+ (let ((include-files (tag-table-include-files)))
+ (when include-files
+ (setq result (nconc result
+ (buffer-tag-table-list-load
+ include-files used-buffers)))))
+ (add-to-list 'result buffer-file-name t)))))
+ list))
+ result))
+
;;;###autoload
(defun visit-tags-table (file)
"Tell tags commands to use tags table file FILE when all else fails.
;; The user wants to build the table:
(condition-case nil
(progn
- (add-to-tag-completion-table)
+ (if tags-exuberant-ctags-optimization-p
+ (add-to-tag-completion-table-exuberant-ctags)
+ (add-to-tag-completion-table))
(setq tag-table-completion-status t))
;; Allow user to C-g out correctly
(quit
;; New include syntax
;; filename,include
;; tacked on to the end of a tag file means use filename as a
- ;; tag file before giving up.
+ ;; tag file before giving up. The filenames are expanded to avoid
+ ;; problems with relative paths being used in the wrong directory.
(let ((files nil))
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "\f\n\\(.*\\),include$" nil t)
- (push (match-string 1) files)))
+ (while (re-search-forward tags-include-pattern nil t)
+ (push (expand-file-name (match-string 1)) files)))
files))
(defun tag-table-files (tag-table)
(defun buffer-tag-table-files ()
"Returns a list of all files referenced by all TAGS tables that
this buffer uses."
- (apply #'nconc
+ (apply #'append
(mapcar #'tag-table-files (buffer-tag-table-list))))
\f
(or (memq tag-table-symbol tag-symbol-tables)
(set tag-symbol (cons tag-table-symbol tag-symbol-tables)))))
-;; Can't use "\\s " in these patterns because that will include newline
+;; Can't use "\\s-" in these patterns because that will include newline
+;; \2 matches an explicit name.
+(defconst tags-explicit-name-pattern "\177\\(\\([^\n\001]+\\)\001\\)?")
+;; \1 matches Lisp-name, \2 matches C-name, \5 (from
+;; tags-explicit-name-pattern) matches explicit name.
(defconst tags-DEFUN-pattern
- "DEFUN[ \t]*(\"\\([^\"]+\\)\",[ \t]*\\(\\(\\sw\\|\\s_\\)+\\),\C-?")
+ (concat "DEFUN[ \t]*(\"\\([^\"]+\\)\",[ \t]*\\(\\(\\sw\\|\\s_\\)+\\),"
+ tags-explicit-name-pattern))
+;; \1 matches an array name. Explicit names unused?
(defconst tags-array-pattern ".*[ \t]+\\([^ \[]+\\)\\[")
+;; \2 matches a Lispish name, \5 (from tags-explicit-name-pattern) matches
+;; explicit name.
(defconst tags-def-pattern
- "\\(.*[ \t]+\\)?\\**\\(\\(\\sw\\|\\s_\\)+\\)[ ();,\t]*\C-?"
-;; "\\(.*[ \t]+\\)?\\(\\(\\sw\\|\\s_\\)+\\)[ ()]*\C-?"
-;; "\\(\\sw\\|\\s_\\)+[ ()]*\C-?"
+ (concat "\\(.*[ \t]+\\)?\\**\\(\\(\\sw\\|\\s_\\)+\\)[ ();,\t]*"
+;; "\\(.*[ \t]+\\)?\\(\\(\\sw\\|\\s_\\)+\\)[ ()]*"
+;; "\\(\\sw\\|\\s_\\)+[ ()]*"
+ tags-explicit-name-pattern)
)
+;; \1 matches Schemish name, \4 (from tags-explicit-name-pattern) matches
+;; explicit name
+(defconst tags-schemish-pattern
+ (concat "\\s-*(\\s-*def\\sw*\\s-*(?\\s-*\\(\\(\\sw\\|\\s_\\|:\\)+\\))?\\s-*"
+ tags-explicit-name-pattern))
(defconst tags-file-pattern "^\f\n\\(.+\\),[0-9]+\n")
+(defconst tags-include-pattern "^\f\n\\(.+\\),include\n"
+ "Holds the pattern for finding the include directive in tagfiles.")
+
+
+(defun add-to-tag-completion-table-exuberant-ctags ()
+ "Sucks the current buffer (a TAGS table) into the completion-table.
+This is a version which is optimized for exuberant etags and will not
+work with xemacs etags."
+ (message "Adding %s to tags completion table..." buffer-file-name)
+ (goto-char (point-min))
+ (let ((tag-table-symbol (intern buffer-file-name tag-completion-table))
+ ;; tag-table-symbol is used by intern-tag-symbol
+ name tag-symbol
+ tag-symbol-tables
+ (case-fold-search nil))
+ (while (re-search-forward tags-explicit-name-pattern nil t)
+ ;; no need to check the mode here
+ (setq name (match-string 2))
+ (intern-tag-symbol name)))
+ (message "Adding %s to tags completion table...done" buffer-file-name))
+
-;; #### Should make it work with the `include' directive!
(defun add-to-tag-completion-table ()
"Sucks the current buffer (a TAGS table) into the completion-table."
(message "Adding %s to tags completion table..." buffer-file-name)
(goto-char (point-min))
(let ((tag-table-symbol (intern buffer-file-name tag-completion-table))
;; tag-table-symbol is used by intern-tag-symbol
- filename file-type name name2 tag-symbol
+ filename file-type name name2 name3 tag-symbol
tag-symbol-tables
(case-fold-search nil))
;; Loop over the files mentioned in the TAGS file for each file,
((string-match "\\.scm\\'" filename)
'scheme-mode)
(t nil)))
+ (defvar c-mode-syntax-table)
(set-syntax-table (cond ((and (eq file-type 'c-mode)
c-mode-syntax-table)
c-mode-syntax-table)
lisp-mode-syntax-table)
(t (standard-syntax-table))))
;; Clear loop variables.
- (setq name nil name2 nil)
+ (setq name nil name2 nil name3 nil)
(lmessage 'progress "%s..." filename)
;; Loop over the individual tag lines.
(while (not (or (eobp) (eq (char-after) ?\f)))
(or (looking-at tags-DEFUN-pattern)
(error "DEFUN doesn't fit pattern"))
(setq name (match-string 1)
- name2 (match-string 2)))
- ;;((looking-at "\\s ")
+ name2 (match-string 2)
+ name3 (match-string 5)))
+ ;;((looking-at "\\s-")
;; skip probably bogus entry:
;;)
((and (eq file-type 'c-mode)
(t
(setq name (match-string 1)))))
((and (eq file-type 'scheme-mode)
- (looking-at "\\s-*(\\s-*def\\sw*\\s-*(?\\s-*\\(\\(\\sw\\|\\s_\\|:\\)+\\))?\\s-*\C-?"))
+ (looking-at tags-schemish-pattern))
;; Something Schemish (is this really necessary??)
- (setq name (match-string 1)))
+ (setq name (match-string 1)
+ name2 (match-string 4)))
((looking-at tags-def-pattern)
;; ???
- (setq name (match-string 2))))
+ (setq name (match-string 2)
+ name2 (match-string 5))))
;; add the tags we found to the completion table
(and name (intern-tag-symbol name))
(and name2 (intern-tag-symbol name2))
+ (and name3 (intern-tag-symbol name3))
(forward-line 1)))
+ ;; Skip over the include entries at the bottom of the file.
+ (while (looking-at tags-include-pattern)
+ (goto-char (match-end 0))
+ (setq filename (file-name-sans-versions (match-string 1)))
+ (forward-line 1))
(or (eobp) (error "Bad TAGS file")))
(message "Adding %s to tags completion table...done" buffer-file-name))
;; Return a default tag to search for, based on the text at point.
(defun find-tag-default ()
(or (and (not (memq find-tag-default-hook '(nil find-tag-default)))
- (condition-case data
- (funcall find-tag-default-hook)
- (error
- (warn "Error in find-tag-default-hook signalled error: %s"
- (error-message-string data))
- nil)))
+ (with-trapping-errors
+ :function 'find-tag-default-hook
+ :error-form nil
+ (funcall find-tag-default-hook)))
(symbol-near-point)))
;; This function depends on the following symbols being bound properly:
(autoload 'get-symbol-syntax-table "symbol-syntax")
(defun find-tag-internal (tagname)
+
(let ((next (null tagname))
(tmpnext (null tagname))
;; If tagname is a list: (TAGNAME), this indicates
(exact-syntax-table (get-symbol-syntax-table (syntax-table)))
tag-table-currently-matching-exact
tag-target exact-tagname
- tag-tables tag-table-point file linebeg startpos buf
+ tag-tables tag-table-point file linebeg line startpos buf
offset found pat syn-tab)
(when (consp tagname)
(setq tagname (car tagname)))
(t
(setq tag-table-currently-matching-exact t)))
;; \_ in the tagname is used to indicate a symbol boundary.
- (setq exact-tagname (format "\C-?\\_%s\\_\C-a\\|\\_%s\\_" tagname tagname))
+ (if tags-exuberant-ctags-optimization-p
+ (setq exact-tagname (format "\C-?%s\C-a" tagname))
+ (setq exact-tagname (format "\C-?%s\C-a\\|\
+\\_%s.?\C-?[0-9]*,[0-9]*$" tagname tagname))
+ )
(while (string-match "\\\\_" exact-tagname)
(aset exact-tagname (1- (match-end 0)) ?b))
(save-excursion
(goto-char (match-beginning 0))
(not (looking-at exact-tagname)))))
(throw 'found t))))
- (setq tag-tables
- (nconc (tag-table-include-files) (cdr tag-tables)))))
+ (setq tag-tables (cdr tag-tables))))
(if (and (not exact) (eq tag-table-currently-matching-exact t))
(setq tag-table-currently-matching-exact nil)
(setq tag-table-currently-matching-exact 'neither)))
(if exact "matching" "containing")
tagname))
(beginning-of-line)
- (search-forward "\C-?")
- (setq file (expand-file-name (file-of-tag)
- ;; In XEmacs, this needs to be
- ;; relative to:
- (or (file-name-directory (car tag-tables))
- "./")))
- (setq linebeg (buffer-substring (1- (point)) (point-at-bol)))
- (search-forward ",")
- (setq startpos (read (current-buffer)))
+
+ ;; from here down, synched with FSF 20.7
+ ;; etags-snarf-tag and etags-goto-tag-location. --ben
+
+ (if (save-excursion
+ (forward-line -1)
+ (looking-at "\f\n"))
+ (progn
+ ;; The match was for a source file name, not any tag
+ ;; within a file. Give text of t, meaning to go exactly
+ ;; to the location we specify, the beginning of the file.
+ (setq linebeg t
+ line nil
+ startpos 1)
+ (setq file
+ (expand-file-name (file-of-tag)
+ ;; In XEmacs, this needs to be
+ ;; relative to:
+ (or (file-name-directory (car tag-tables))
+ "./"))))
+ (search-forward "\C-?")
+ (setq file
+ (expand-file-name (file-of-tag)
+ ;; In XEmacs, this needs to be
+ ;; relative to:
+ (or (file-name-directory (car tag-tables))
+ "./")))
+ (setq linebeg (buffer-substring (1- (point)) (point-at-bol)))
+ ;; Skip explicit tag name if present.
+ (search-forward "\001" (save-excursion (forward-line 1) (point)) t)
+ (if (looking-at "[0-9]")
+ (setq line (string-to-int (buffer-substring
+ (point)
+ (progn (skip-chars-forward "0-9")
+ (point))))))
+ (search-forward ",")
+ (if (looking-at "[0-9]")
+ (setq startpos (string-to-int (buffer-substring
+ (point)
+ (progn (skip-chars-forward "0-9")
+ (point)))))))
+ ;; Leave point on the next line of the tags file.
+ (forward-line 1)
(setq last-tag-data
(nconc (list tagname (point) tag-table-currently-matching-exact)
tag-tables))
(setq buf (find-file-noselect file))
+
+ ;; LINEBEG is the initial part of a line containing the tag and
+ ;; STARTPOS is the character position of LINEBEG within the file
+ ;; (starting from 1); LINE is the line number. If LINEBEG is t,
+ ;; it means the tag refers to exactly LINE or STARTPOS
+ ;; (whichever is present, LINE having preference, no searching).
+ ;; Either LINE or STARTPOS may be nil; STARTPOS is used if
+ ;; present. If the tag isn't exactly at the given position then
+ ;; look around that position using a search window which expands
+ ;; until it hits the start of file.
+
(with-current-buffer buf
(save-excursion
(save-restriction
(widen)
- ;; Here we search for PAT in the range [STARTPOS - OFFSET,
- ;; STARTPOS + OFFSET], with increasing values of OFFSET.
- ;;
- ;; We used to set the initial offset to 1000, but the
- ;; actual sources show that finer-grained control is
- ;; needed (e.g. two `hash_string's in src/symbols.c.) So,
- ;; I changed 100 to 100, and (* 3 offset) to (* 5 offset).
- (setq offset 100)
- (setq pat (concat "^" (regexp-quote linebeg)))
- (or startpos (setq startpos (point-min)))
- (while (and (not found)
- (progn
- (goto-char (- startpos offset))
- (not (bobp))))
- (setq found (re-search-forward pat (+ startpos offset) t))
- (setq offset (* 5 offset)))
- ;; Finally, try finding it anywhere in the buffer.
- (or found
- (re-search-forward pat nil t)
- (error "%s not found in %s" pat file))
- (beginning-of-line)
- (setq startpos (point)))))
+ (if (eq linebeg t)
+ ;; Direct file tag.
+ (cond (line (goto-line line))
+ (startpos (goto-char startpos))
+ (t (error "etags.el BUG: bogus direct file tag")))
+ ;; Here we search for PAT in the range [STARTPOS - OFFSET,
+ ;; STARTPOS + OFFSET], with increasing values of OFFSET.
+ ;;
+ ;; We used to set the initial offset to 1000, but the
+ ;; actual sources show that finer-grained control is
+ ;; needed (e.g. two `hash_string's in src/symbols.c.) So,
+ ;; I changed 1000 to 100, and (* 3 offset) to (* 5 offset).
+ (setq offset 100)
+ (setq pat (concat (if (eq selective-display t)
+ "\\(^\\|\^m\\)" "^")
+ (regexp-quote linebeg)))
+
+ ;; The character position in the tags table is 0-origin.
+ ;; Convert it to a 1-origin Emacs character position.
+ (if startpos (setq startpos (1+ startpos)))
+ ;; If no char pos was given, try the given line number.
+ (or startpos
+ (if line
+ (setq startpos (progn (goto-line line)
+ (point)))))
+ (or startpos
+ (setq startpos (point-min)))
+ ;; First see if the tag is right at the specified location.
+ (goto-char startpos)
+ (setq found (looking-at pat))
+ (while (and (not found)
+ (progn
+ (goto-char (- startpos offset))
+ (not (bobp))))
+ (setq found
+ (re-search-forward pat (+ startpos offset) t)
+ offset (* 5 offset))) ; expand search window
+ ;; Finally, try finding it anywhere in the buffer.
+ (or found
+ (re-search-forward pat nil t)
+ (error "Rerun etags: `%s' not found in %s"
+ pat file))))
+ ;; Position point at the right place
+ ;; if the search string matched an extra Ctrl-m at the beginning.
+ (and (eq selective-display t)
+ (looking-at "\^m")
+ (forward-char 1))
+ (beginning-of-line)
+ (setq startpos (point))))
(cons buf startpos))))
;;;###autoload
+(defun find-tag-at-point (tagname &optional other-window)
+ "*Find tag whose name contains TAGNAME.
+Identical to `find-tag' but does not prompt for tag when called interactively;
+instead, uses tag around or before point."
+ (interactive (if current-prefix-arg
+ '(nil nil)
+ (list (find-tag-default) nil)))
+ (find-tag tagname other-window))
+
+;;;###autoload
(defun find-tag (tagname &optional other-window)
"*Find tag whose name contains TAGNAME.
Selects the buffer that the tag is contained in
projects / chise / xemacs-chise.git.1 / blobdiff