;;; 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, 2007, 2008
-;; 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
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)
(defun tags-table-mode ()
"Major mode for tags table file buffers."
(interactive)
- (setq major-mode 'tags-table-mode
+ (setq major-mode 'tags-table-mode ;FIXME: Use define-derived-mode.
mode-name "Tags Table"
buffer-undo-list t)
(initialize-new-tags-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
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. Nil CORE-ONLY is ignored."
+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.
(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
(defun find-tag-tag (string)
"Read a tag name, with defaulting and completion."
;; 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
;; 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)))))
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)))
(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)
(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))
(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
(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.
(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)))
- (comp-table (tags-lazy-completion-table))
- beg
- completion)
- (or pattern
- (error "Nothing to complete"))
- (search-backward pattern)
- (setq beg (point))
- (forward-char (length pattern))
- (setq completion (try-completion pattern comp-table))
- (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 comp-table 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