;;; etags.el --- etags facility for Emacs
-;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995, 1996, 1998,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995, 1996,
+;; 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+;; 2010, 2011 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+(eval-when-compile
+ (require 'cl))
(require 'ring)
(require 'button)
If you set this variable, do not also set `tags-table-list'.
Use the `etags' program to make a tags table file.")
;; Make M-x set-variable tags-file-name like M-x visit-tags-table.
-;;;###autoload (put 'tags-file-name 'variable-interactive "fVisit tags table: ")
+;;;###autoload (put 'tags-file-name 'variable-interactive (purecopy "fVisit tags table: "))
+;;;###autoload (put 'tags-file-name 'safe-local-variable 'stringp)
(defgroup etags nil "Tags tables."
:group 'tools)
:type '(repeat file))
;;;###autoload
-(defcustom tags-compression-info-list '("" ".Z" ".bz2" ".gz" ".tgz")
+(defcustom tags-compression-info-list
+ (purecopy '("" ".Z" ".bz2" ".gz" ".xz" ".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')."
+ :version "24.1" ; added xz
:type '(repeat string)
:group 'etags)
(defvar tags-included-tables-function nil
"Function to do the work of `tags-included-tables' (which see).")
(defvar verify-tags-table-function nil
- "Function to return t iff current buffer contains valid tags file.")
+ "Function to return t if current buffer contains valid tags file.")
\f
-;; Initialize the tags table in the current buffer.
-;; Returns non-nil iff it is a valid tags table. On
-;; non-nil return, the tags table state variable are
-;; made buffer-local and initialized to nil.
(defun initialize-new-tags-table ()
+ "Initialize the tags table in the current buffer.
+Return non-nil if it is a valid tags table, and
+in that case, also make the tags table state variables
+buffer-local and set them to nil."
(set (make-local-variable 'tags-table-files) nil)
(set (make-local-variable 'tags-completion-table) nil)
(set (make-local-variable 'tags-included-tables) nil)
(defun tags-table-mode ()
"Major mode for tags table file buffers."
(interactive)
- (setq major-mode 'tags-table-mode)
- (setq mode-name "Tags Table")
+ (setq major-mode 'tags-table-mode ;FIXME: Use define-derived-mode.
+ mode-name "Tags Table"
+ buffer-undo-list t)
(initialize-new-tags-table))
;;;###autoload
current-prefix-arg))
(or (stringp file) (signal 'wrong-type-argument (list 'stringp file)))
;; Bind tags-file-name so we can control below whether the local or
- ;; global value gets set. Calling visit-tags-table-buffer will
- ;; initialize a buffer for the file and set tags-file-name to the
+ ;; global value gets set.
;; Calling visit-tags-table-buffer with tags-file-name set to FILE will
;; initialize a buffer for FILE and set tags-file-name to the
;; fully-expanded name.
;; it is initialized as a tag table buffer.
(save-excursion
(tags-verify-table (buffer-file-name table-buffer))))
- (save-excursion
- (set-buffer table-buffer)
+ (with-current-buffer table-buffer
(if (tags-included-tables)
;; Insert the included tables into the list we
;; are processing.
(setq tags-table-computed-list-for compute-for
tags-table-computed-list (nreverse computed))))))
-;; Extend `tags-table-computed-list' to remove the first `t' placeholder.
-;; An element of the list that is `t' is a placeholder indicating that the
-;; preceding element is a table that has not been read into core and might
-;; contain included tables to search. On return, the first placeholder
-;; element will be gone and the element before it read into core and its
-;; included tables inserted into the list.
(defun tags-table-extend-computed-list ()
+ "Extend `tags-table-computed-list' to remove the first t placeholder.
+
+An element of the list that is t is a placeholder indicating that the
+preceding element is a table that has not been read in and might
+contain included tables to search. This function reads in the first
+such table and puts its included tables into the list."
(let ((list tags-table-computed-list))
(while (not (eq (nth 1 list) t))
(setq list (cdr list)))
(setq computed (cons (car tables) computed)
table-buffer (get-file-buffer (car tables)))
(if table-buffer
- (save-excursion
- (set-buffer table-buffer)
+ (with-current-buffer table-buffer
(if (tags-included-tables)
;; Insert the included tables into the list we
;; are processing.
;; It was not a valid table, so just remove the following placeholder.
(setcdr list (cdr (cdr list)))))))
-;; Expand tags table name FILE into a complete file name.
(defun tags-expand-table-name (file)
+ "Expand tags table name FILE into a complete file name."
(setq file (expand-file-name file))
(if (file-directory-p file)
(expand-file-name "TAGS" file)
;; Like member, but comparison is done after tags-expand-table-name on both
;; sides and elements of LIST that are t are skipped.
(defun tags-table-list-member (file list)
+ "Like (member FILE LIST) after applying `tags-expand-table-name'.
+More precisely, apply `tags-expand-table-name' to FILE
+and each element of LIST, returning the link whose car is the first match.
+If an element of LIST is t, ignore it."
(setq file (tags-expand-table-name file))
(while (and list
(or (eq (car list) t)
(defun tags-verify-table (file)
"Read FILE into a buffer and verify that it is a valid tags table.
Sets the current buffer to one visiting FILE (if it exists).
-Returns non-nil iff it is a valid table."
+Returns non-nil if it is a valid table."
(if (get-file-buffer file)
;; The file is already in a buffer. Check for the visited file
;; having changed since we last used it.
- (let (win)
+ (progn
(set-buffer (get-file-buffer file))
- (setq win (or verify-tags-table-function (tags-table-mode)))
+ (or verify-tags-table-function (tags-table-mode))
(if (or (verify-visited-file-modtime (current-buffer))
;; Decide whether to revert the file.
;; revert-without-query can say to revert
(funcall verify-tags-table-function))
(revert-buffer t t)
(tags-table-mode)))
- (and (file-exists-p file)
- (progn
- (set-buffer (find-file-noselect file))
- (or (string= file buffer-file-name)
- ;; find-file-noselect has changed the file name.
- ;; Propagate the change to tags-file-name and tags-table-list.
- (let ((tail (member file tags-table-list)))
- (if tail
- (setcar tail buffer-file-name))
- (if (eq file tags-file-name)
- (setq tags-file-name buffer-file-name))))
- (tags-table-mode)))))
+ (when (file-exists-p file)
+ (let* ((buf (find-file-noselect file))
+ (newfile (buffer-file-name buf)))
+ (unless (string= file newfile)
+ ;; find-file-noselect has changed the file name.
+ ;; Propagate the change to tags-file-name and tags-table-list.
+ (let ((tail (member file tags-table-list)))
+ (if tail (setcar tail newfile)))
+ (if (eq file tags-file-name) (setq tags-file-name newfile)))
+ ;; Only change buffer now that we're done using potentially
+ ;; buffer-local variables.
+ (set-buffer buf)
+ (tags-table-mode)))))
;; Subroutine of visit-tags-table-buffer. Search the current tags tables
;; for one that has tags for THIS-FILE (or that includes a table that
;; we return. If CORE-ONLY is non-nil, check only tags tables that are
;; already in buffers--don't visit any new files.
(defun tags-table-including (this-file core-only)
+ "Search current tags tables for tags for THIS-FILE.
+Subroutine of `visit-tags-table-buffer'.
+Looks for a tags table that has such tags or that includes a table
+that has them. Returns the name of the first such table.
+Non-nil CORE-ONLY means check only tags tables that are already in
+buffers. If CORE-ONLY is nil, it is ignored."
(let ((tables tags-table-computed-list)
(found nil))
;; Loop over the list, looking for a table containing tags for THIS-FILE.
;; included the one we found.
could-be))))
-;; Subroutine of visit-tags-table-buffer. Move tags-table-list-pointer
-;; along and set tags-file-name. Returns nil when out of tables.
(defun tags-next-table ()
+ "Move `tags-table-list-pointer' along and set `tags-file-name'.
+Subroutine of `visit-tags-table-buffer'.\
+Returns nil when out of tables."
;; If there is a placeholder element next, compute the list to replace it.
(while (eq (nth 1 tags-table-list-pointer) t)
(tags-table-extend-computed-list))
tags-table-set-list)))
;; Clear out buffers holding old tables.
(dolist (table tags-table-list)
- ;; The list can contain items `t'.
+ ;; The list can contain items t.
(if (stringp table)
(let ((buffer (find-buffer-visiting table)))
(if buffer
(or tags-included-tables
(setq tags-included-tables (funcall tags-included-tables-function))))
\f
-;; Build tags-completion-table on demand. The single current tags table
-;; and its included tags tables (and their included tables, etc.) have
-;; their tags included in the completion table.
(defun tags-completion-table ()
+ "Build `tags-completion-table' on demand.
+The tags included in the completion table are those in the current
+tags table and its (recursively) included tags tables."
(or tags-completion-table
+ ;; No cached value for this buffer.
(condition-case ()
- (prog2
- (message "Making tags completion table for %s..." buffer-file-name)
- (let ((included (tags-included-tables))
- (table (funcall tags-completion-table-function)))
- (save-excursion
- ;; Iterate over the list of included tables, and combine each
- ;; included table's completion obarray to the parent obarray.
- (while included
- ;; Visit the buffer.
- (let ((tags-file-name (car included)))
- (visit-tags-table-buffer 'same))
- ;; Recurse in that buffer to compute its completion table.
- (if (tags-completion-table)
- ;; Combine the tables.
- (mapatoms (lambda (sym) (intern (symbol-name sym) table))
- tags-completion-table))
- (setq included (cdr included))))
- (setq tags-completion-table table))
- (message "Making tags completion table for %s...done"
- buffer-file-name))
+ (let (current-table combined-table)
+ (message "Making tags completion table for %s..." buffer-file-name)
+ (save-excursion
+ ;; Iterate over the current list of tags tables.
+ (while (visit-tags-table-buffer (and combined-table t))
+ ;; Find possible completions in this table.
+ (setq current-table (funcall tags-completion-table-function))
+ ;; Merge this buffer's completions into the combined table.
+ (if combined-table
+ (mapatoms
+ (lambda (sym) (intern (symbol-name sym) combined-table))
+ current-table)
+ (setq combined-table current-table))))
+ (message "Making tags completion table for %s...done"
+ buffer-file-name)
+ ;; Cache the result in a buffer-local variable.
+ (setq tags-completion-table combined-table))
(quit (message "Tags completion table construction aborted.")
(setq tags-completion-table nil)))))
-;; Completion function for tags. Does normal try-completion,
-;; but builds tags-completion-table on demand.
-(defun tags-complete-tag (string predicate what)
- (save-excursion
- ;; If we need to ask for the tag table, allow that.
- (let ((enable-recursive-minibuffers t))
- (visit-tags-table-buffer))
- (if (eq what t)
- (all-completions string (tags-completion-table) predicate)
- (try-completion string (tags-completion-table) predicate))))
+(defun tags-lazy-completion-table ()
+ (lexical-let ((buf (current-buffer)))
+ (lambda (string pred action)
+ (with-current-buffer buf
+ (save-excursion
+ ;; If we need to ask for the tag table, allow that.
+ (let ((enable-recursive-minibuffers t))
+ (visit-tags-table-buffer))
+ (complete-with-action action (tags-completion-table) string pred))))))
+
+;;;###autoload (defun tags-completion-at-point-function ()
+;;;###autoload (if (or tags-table-list tags-file-name)
+;;;###autoload (progn
+;;;###autoload (load "etags")
+;;;###autoload (tags-completion-at-point-function))))
+
+(defun tags-completion-at-point-function ()
+ "Using tags, return a completion table for the text around point.
+If no tags table is loaded, do nothing and return nil."
+ (when (or tags-table-list tags-file-name)
+ (let ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
+ tags-case-fold-search
+ case-fold-search))
+ (pattern (funcall (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default)))
+ beg)
+ (when pattern
+ (save-excursion
+ (search-backward pattern) ;FIXME: will fail if we're inside pattern.
+ (setq beg (point))
+ (forward-char (length pattern))
+ (list beg (point) (tags-lazy-completion-table)))))))
\f
-;; Read a tag name from the minibuffer with defaulting and completion.
(defun find-tag-tag (string)
+ "Read a tag name, with defaulting and completion."
(let* ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
tags-case-fold-search
case-fold-search))
(substring string 0 (string-match "[ :]+\\'" string))
default)
string)
- 'tags-complete-tag
+ (tags-lazy-completion-table)
nil nil nil nil default)))
(if (equal spec "")
(or default (error "There is no default tag"))
(defvar last-tag nil
"Last tag found by \\[find-tag].")
-;; Get interactive args for find-tag{-noselect,-other-window,-regexp}.
(defun find-tag-interactive (prompt &optional no-default)
+ "Get interactive arguments for tag functions.
+The functions using this are `find-tag-noselect',
+`find-tag-other-window', and `find-tag-regexp'."
(if (and current-prefix-arg last-tag)
(list nil (if (< (prefix-numeric-value current-prefix-arg) 0)
'-
(read-string prompt)
(find-tag-tag prompt)))))
-(defvar find-tag-history nil)
+(defvar find-tag-history nil) ; Doc string?
;; Dynamic bondage:
-(eval-when-compile
- (defvar etags-case-fold-search)
- (defvar etags-syntax-table))
+(defvar etags-case-fold-search)
+(defvar etags-syntax-table)
;;;###autoload
(defun find-tag-noselect (tagname &optional next-p regexp-p)
(setq last-tag tagname))
;; Record the location so we can pop back to it later.
(let ((marker (make-marker)))
- (save-excursion
- (set-buffer
- ;; find-tag-in-order does the real work.
- (find-tag-in-order
- (if (and next-p last-tag) last-tag tagname)
- (if regexp-p
- find-tag-regexp-search-function
- find-tag-search-function)
- (if regexp-p
- find-tag-regexp-tag-order
- find-tag-tag-order)
- (if regexp-p
- find-tag-regexp-next-line-after-failure-p
- find-tag-next-line-after-failure-p)
- (if regexp-p "matching" "containing")
- (or (not next-p) (not last-tag))))
+ (with-current-buffer
+ ;; find-tag-in-order does the real work.
+ (find-tag-in-order
+ (if (and next-p last-tag) last-tag tagname)
+ (if regexp-p
+ find-tag-regexp-search-function
+ find-tag-search-function)
+ (if regexp-p
+ find-tag-regexp-tag-order
+ find-tag-tag-order)
+ (if regexp-p
+ find-tag-regexp-next-line-after-failure-p
+ find-tag-next-line-after-failure-p)
+ (if regexp-p "matching" "containing")
+ (or (not next-p) (not last-tag)))
(set-marker marker (point))
(run-hooks 'local-find-tag-hook)
(ring-insert tags-location-ring marker)
(goto-char (marker-position marker))
(set-marker marker nil nil)))
\f
-;; Internal tag finding function.
-
-;; PATTERN is a string to pass to second arg SEARCH-FORWARD-FUNC, and to
-;; any member of the function list ORDER (third arg). If ORDER is nil,
-;; use saved state to continue a previous search.
-
-;; 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
-;; qualifier-func. If it qualifies, go to the specified line in the
-;; specified source file and return. Qualified matches are remembered to
-;; avoid repetition. State is saved so that the loop can be continued.
-
-(defvar tag-lines-already-matched nil) ;matches remembered here between calls
+(defvar tag-lines-already-matched nil
+ "Matches remembered between calls.") ; Doc string: calls to what?
(defun find-tag-in-order (pattern
search-forward-func
next-line-after-failure-p
matching
first-search)
+ "Internal tag-finding function.
+PATTERN is a string to pass to arg SEARCH-FORWARD-FUNC, and to any
+member of the function list ORDER. If ORDER is nil, use saved state
+to continue a previous search.
+
+Arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
+point should be moved to the next line.
+
+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 qualifier-func. If
+;; it qualifies, go to the specified line in the specified source file
+;; and return. Qualified matches are remembered to avoid repetition.
+;; State is saved so that the loop can be continued.
(let (file ;name of file containing tag
tag-info ;where to find the tag in FILE
(first-table t)
;; Naive match found. Qualify the match.
(and (funcall (car order) pattern)
;; Make sure it is not a previous qualified match.
- (not (member (set-marker match-marker (save-excursion
- (beginning-of-line)
- (point)))
+ (not (member (set-marker match-marker (point-at-bol))
tag-lines-already-matched))
(throw 'qualified-match-found nil))
(if next-line-after-failure-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)
+ (save-excursion (forward-line 1)
(file-of-tag))
(file-of-tag)))
tag-info (funcall snarf-tag-function))
(current-buffer))))
(defun tag-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.
+ "Find the right line in the specified FILE."
+ ;; If interested in compressed-files, search files with extensions.
+ ;; Otherwise, search only the real file.
(let* ((buffer-search-extensions (if (featurep 'jka-compr)
tags-compression-info-list
'("")))
(error "File %s not found" file))
(set-buffer the-buffer))))
-(defun tag-find-file-of-tag (file)
+(defun tag-find-file-of-tag (file) ; Doc string?
(let ((buf (tag-find-file-of-tag-noselect file)))
(condition-case nil
(switch-to-buffer buf)
\f
;; `etags' TAGS file format support.
-;; If the current buffer is a valid etags TAGS file, give it local values of
-;; the tags table format variables, and return non-nil.
(defun etags-recognize-tags-table ()
+ "If `etags-verify-tags-table', make buffer-local format variables.
+If current buffer is a valid etags TAGS file, then give it
+buffer-local values of tags table format variables."
(and (etags-verify-tags-table)
;; It is annoying to flash messages on the screen briefly,
;; and this message is not useful. -- rms
(verify-tags-table-function . etags-verify-tags-table)
))))
-;; Return non-nil iff the current buffer is a valid etags TAGS file.
(defun etags-verify-tags-table ()
+ "Return non-nil if the current buffer is a valid etags TAGS file."
;; Use eq instead of = in case char-after returns nil.
(eq (char-after (point-min)) ?\f))
-(defun etags-file-of-tag (&optional relative)
+(defun etags-file-of-tag (&optional relative) ; Doc string?
(save-excursion
(re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n")
(let ((str (buffer-substring (match-beginning 1) (match-end 1))))
(file-truename default-directory))))))
-(defun etags-tags-completion-table ()
+(defun etags-tags-completion-table () ; Doc string?
(let ((table (make-vector 511 0))
(progress-reporter
(make-progress-reporter
table)))
table))
-(defun etags-snarf-tag (&optional use-explicit)
+(defun etags-snarf-tag (&optional use-explicit) ; Doc string?
(let (tag-text line startpos explicit-start)
(if (save-excursion
(forward-line -1)
;; Find the end of the tag and record the whole tag text.
(search-forward "\177")
- (setq tag-text (buffer-substring (1- (point))
- (save-excursion (beginning-of-line)
- (point))))
+ (setq tag-text (buffer-substring (1- (point)) (point-at-bol)))
;; 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)
+ (when (and (search-forward "\001" (point-at-bol 2) t)
use-explicit)
(setq tag-text (buffer-substring explicit-start (1- (point)))))
(forward-line 1)
(cons tag-text (cons line startpos))))
-;; TAG-INFO is a cons (TEXT LINE . POSITION) where TEXT is the initial part
-;; of a line containing the tag and POSITION is the character position of
-;; TEXT within the file (starting from 1); LINE is the line number. If
-;; TEXT is t, it means the tag refers to exactly LINE or POSITION
-;; (whichever is present, LINE having preference, no searching. Either
-;; LINE or POSITION may be nil; POSITION 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.
(defun etags-goto-tag-location (tag-info)
+ "Go to location of tag specified by TAG-INFO.
+TAG-INFO is a cons (TEXT LINE . POSITION).
+TEXT is the initial part of a line containing the tag.
+LINE is the line number.
+POSITION is the (one-based) char position of TEXT within the file.
+
+If TEXT is t, it means the tag refers to exactly LINE or POSITION,
+whichever is present, LINE having preference, no searching.
+Either LINE or POSITION can be nil. POSITION is used if present.
+
+If the tag isn't exactly at the given position, then look near that
+position using a search window that expands progressively until it
+hits the start of file."
(let ((startpos (cdr (cdr tag-info)))
(line (car (cdr tag-info)))
offset found pat)
(if (eq (car tag-info) t)
;; Direct file tag.
- (cond (line (goto-line line))
+ (cond (line (progn (goto-char (point-min))
+ (forward-line (1- line))))
(startpos (goto-char startpos))
(t (error "etags.el BUG: bogus direct file tag")))
;; This constant is 1/2 the initial search window.
;; If no char pos was given, try the given line number.
(or startpos
(if line
- (setq startpos (progn (goto-line line)
+ (setq startpos (progn (goto-char (point-min))
+ (forward-line (1- line))
(point)))))
(or startpos
(setq startpos (point-min)))
(forward-char 1))
(beginning-of-line)))
-(defun etags-list-tags (file)
+(defun etags-list-tags (file) ; Doc string?
(goto-char (point-min))
(when (re-search-forward (concat "\f\n" "\\(" file "\\)" ",") nil t)
(let ((path (save-excursion (forward-line 1) (file-of-tag)))
(tag-find-file-of-tag (button-get button 'file-path))
(widen)
(funcall goto-func tag-info)))
- 'face 'tags-tag-face
+ 'follow-link t
+ 'face tags-tag-face
'type 'button))
(terpri)
(forward-line 1))
(button-get button 'item)))
'item sn
'face tags-tag-face
+ 'follow-link t
'type 'button)
(terpri))))))
(when (symbolp symbs)
(funcall ins-symb (car sy))))
(sort-lines nil beg (point))))))
-(defun etags-tags-apropos (string)
+(defun etags-tags-apropos (string) ; Doc string?
(when tags-apropos-verbose
(princ "Tags in file `")
(tags-with-face 'highlight (princ buffer-file-name))
(tag-info (save-excursion (funcall snarf-tag-function)))
(tag (if (eq t (car tag-info)) nil (car tag-info)))
(file-path (save-excursion (if tag (file-of-tag)
- (save-excursion (next-line 1)
+ (save-excursion (forward-line 1)
(file-of-tag)))))
(file-label (if tag (file-of-tag t)
- (save-excursion (next-line 1)
+ (save-excursion (forward-line 1)
(file-of-tag t))))
(pt (with-current-buffer standard-output (point))))
(if tag
(tag-find-file-of-tag (button-get button 'file-path))
(widen)
(funcall goto-func tag-info)))
- 'face 'tags-tag-face
+ 'follow-link t
+ 'face tags-tag-face
'type 'button)))
(princ (format "- %s" file-label))
(with-current-buffer standard-output
;; Get the local value in the tags table
;; buffer before switching buffers.
(goto-char (point-min)))
- 'face 'tags-tag-face
- 'type 'button))
- ))
+ 'follow-link t
+ 'face tags-tag-face
+ 'type 'button))))
(terpri)
(forward-line 1))
(message nil))
(when tags-apropos-verbose (princ "\n")))
-(defun etags-tags-table-files ()
+(defun etags-tags-table-files () ; Doc string?
(let ((files nil)
beg)
(goto-char (point-min))
(setq files (cons (buffer-substring beg (1- (point))) files))))
(nreverse files)))
-(defun etags-tags-included-tables ()
+(defun etags-tags-included-tables () ; Doc string?
(let ((files nil)
beg)
(goto-char (point-min))
\f
;; Empty tags file support.
-;; Recognize an empty file and give it local values of the tags table format
-;; variables which do nothing.
(defun tags-recognize-empty-tags-table ()
+ "Return non-nil if current buffer is empty.
+If empty, make buffer-local values of the tags table format variables
+that do nothing."
(and (zerop (buffer-size))
(mapc (lambda (sym) (set (make-local-variable sym) 'ignore))
'(tags-table-files-function
;; This might be a neat idea, but it's too hairy at the moment.
;;(defmacro tags-with-syntax (&rest body)
-;; `(let ((current (current-buffer))
-;; (otable (syntax-table))
-;; (buffer (find-file-noselect (file-of-tag)))
-;; table)
-;; (unwind-protect
-;; (progn
-;; (set-buffer buffer)
-;; (setq table (syntax-table))
-;; (set-buffer current)
-;; (set-syntax-table table)
-;; ,@body)
-;; (set-syntax-table otable))))
+;; `(with-syntax-table
+;; (with-current-buffer (find-file-noselect (file-of-tag))
+;; (syntax-table))
+;; ,@body))
;;(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)
+ "Return non-nil if TAG matches complete file name.
+Any directory part of the file name is also matched."
(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)
+ "Return non-nil if TAG matches file name, excluding directory part."
(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 ?
;; 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)
+ "Return non-nil if current tag line matches TAG exactly.
+Point should be just after a string that matches TAG."
;; The match is really exact if there is an explicit tag name.
(or (and (eq (char-after (point)) ?\001)
(eq (char-after (- (point) (length tag) 1)) ?\177))
;; 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)
+ "Return non-nil if current tag line has an implicit name.
+Point should be just after a string that matches 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
;; 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)
+ "Return non-nil if current tag line matches TAG as a symbol.
+Point should be just after a string that matches TAG."
(and (looking-at "\\Sw.*\177") (looking-at "\\S_.*\177")
(save-excursion
(backward-char (1+ (length tag)))
;; t if point is at a tag line that matches TAG as a word.
;; point should be just after a string that matches TAG.
(defun tag-word-match-p (tag)
+ "Return non-nil if current tag line matches TAG as a word.
+Point should be just after a string that matches TAG."
(and (looking-at "\\b.*\177")
(save-excursion (backward-char (length tag))
(looking-at "\\b"))))
;; 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)
+ "Return non-nil if current tag matches file name.
+This is a substring match, and it can include directory separators.
+Point should be just after a string that matches TAG."
(and (looking-at ".*,[0-9\n]")
(save-excursion (beginning-of-line)
(backward-char 2)
;; t if point is in a tag line with a tag containing TAG as a substring.
(defun tag-any-match-p (tag)
+ "Return non-nil if current tag line contains TAG as a substring."
(looking-at ".*\177"))
;; t if point is at a tag line that matches RE as a regexp.
(defun tag-re-match-p (re)
+ "Return non-nil if current tag line matches regexp RE."
(save-excursion
(beginning-of-line)
(let ((bol (point)))
- (and (search-forward "\177" (save-excursion (end-of-line) (point)) t)
+ (and (search-forward "\177" (line-end-position) t)
(re-search-backward re bol t)))))
\f
(defcustom tags-loop-revert-buffers nil
;; if the files have changed on disk.
(and buffer tags-loop-revert-buffers
(not (verify-visited-file-modtime buffer))
+ (y-or-n-p
+ (format
+ (if (buffer-modified-p buffer)
+ "File %s changed on disk. Discard your edits? "
+ "File %s changed on disk. Reread from disk? ")
+ next))
(with-current-buffer buffer
- (revert-buffer t)))
+ (revert-buffer t t)))
(if (not (and new novisit))
(set-buffer (find-file-noselect next novisit))
;; Like find-file, but avoids random warning messages.
(tags-loop-continue (or file-list-form t))))
;;;###autoload
-(defun tags-query-replace (from to &optional delimited file-list-form start end)
+(defun tags-query-replace (from to &optional delimited file-list-form)
"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], RET or q), you can resume the query replace
with the command \\[tags-loop-continue].
+Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop.
+Fifth and sixth arguments START and END are accepted, for compatibility
+with `query-replace-regexp', and ignored.
-See documentation of variable `tags-file-name'."
+If FILE-LIST-FORM is non-nil, it is a form to evaluate to
+produce the list of files to search.
+
+See also the documentation of the variable `tags-file-name'."
(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)))
;; 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-operate `(perform-replace ',from ',to t t ',delimited
+ nil multi-query-replace-map))
(tags-loop-continue (or file-list-form t)))
\f
-(defun tags-complete-tags-table-file (string predicate what)
+(defun tags-complete-tags-table-file (string predicate what) ; Doc string?
(save-excursion
;; If we need to ask for the tag table, allow that.
(let ((enable-recursive-minibuffers t))
(funcall tags-apropos-function regexp))))
(etags-tags-apropos-additional regexp))
(with-current-buffer "*Tags List*"
- (require 'apropos)
+ (eval-and-compile (require 'apropos))
(apropos-mode)
;; apropos-mode is derived from fundamental-mode and it kills
;; all local variables.
(define-button-type 'tags-select-tags-table
'action 'select-tags-table-select
+ 'follow-link t
'help-echo "RET, t or mouse-2: select tags table")
;; XXX If a file is in multiple tables, selection may get the wrong one.
see the doc of that variable if you want to add names to the list."
(interactive)
(pop-to-buffer "*Tags Table List*")
- (setq buffer-read-only nil)
+ (setq buffer-read-only nil
+ buffer-undo-list t)
(erase-buffer)
(let ((set-list tags-table-set-list)
(desired-point nil)
(set-buffer-modified-p nil)
(select-tags-table-mode))
-(defvar select-tags-table-mode-map
+(defvar select-tags-table-mode-map ; Doc string?
(let ((map (make-sparse-keymap)))
(set-keymap-parent map button-buffer-map)
(define-key map "t" 'push-button)
(define-key map "q" 'select-tags-table-quit)
map))
-(define-derived-mode select-tags-table-mode fundamental-mode "Select Tags Table"
- "Major mode for choosing a current tags table among those already loaded.
-
-\\{select-tags-table-mode-map}"
+(define-derived-mode select-tags-table-mode special-mode "Select Tags Table"
+ "Major mode for choosing a current tags table among those already loaded."
(setq buffer-read-only t))
(defun select-tags-table-select (button)
(interactive)
(quit-window t (selected-window)))
\f
-;; Note, there is another definition of this function in bindings.el.
;;;###autoload
(defun complete-tag ()
"Perform tags completion on the text around point.
(error "%s"
(substitute-command-keys
"No tags table loaded; try \\[visit-tags-table]")))
- (let ((completion-ignore-case (if (memq tags-case-fold-search '(t nil))
- tags-case-fold-search
- case-fold-search))
- (pattern (funcall (or find-tag-default-function
- (get major-mode 'find-tag-default-function)
- 'find-tag-default)))
- beg
- completion)
- (or pattern
- (error "Nothing to complete"))
- (search-backward pattern)
- (setq beg (point))
- (forward-char (length pattern))
- (setq completion (tags-complete-tag pattern nil nil))
- (cond ((eq completion t))
- ((null completion)
- (message "Can't find completion for \"%s\"" pattern)
- (ding))
- ((not (string= pattern completion))
- (delete-region beg (point))
- (insert completion))
- (t
- (message "Making completion list...")
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list
- (all-completions pattern 'tags-complete-tag nil)
- pattern))
- (message "Making completion list...%s" "done")))))
+ (let ((comp-data (tags-completion-at-point-function)))
+ (if (null comp-data)
+ (error "Nothing to complete")
+ (apply 'completion-in-region comp-data))))
(dolist (x '("^No tags table in use; use .* to select one$"
"^There is no default tag$"
\f
(provide 'etags)
-;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e
;;; etags.el ends here
HCoop / bpt / emacs.git / blobdiff