;;; etags.el --- etags facility for Emacs
-;; Copyright (C) 1985, 86, 88, 89, 92, 93, 94, 95, 96, 98, 2000, 2001
+;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995, 1996, 1998,
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006
;; Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Value is t if we have found a valid tags table buffer.
(run-hook-with-args-until-success 'tags-table-format-functions))
+;;;###autoload
+(defun tags-table-mode ()
+ "Major mode for tags table file buffers."
+ (interactive)
+ (setq major-mode 'tags-table-mode)
+ (setq mode-name "Tags Table")
+ (initialize-new-tags-table))
+
;;;###autoload
(defun visit-tags-table (file &optional local)
"Tell tags commands to use tags table file FILE.
When you find a tag with \\[find-tag], the buffer it finds the tag
in is given a local value of this variable which is the name of the tags
file the tag was in."
- (interactive (list (read-file-name "Visit tags table: (default TAGS) "
+ (interactive (list (read-file-name "Visit tags table (default TAGS): "
default-directory
(expand-file-name "TAGS"
default-directory)
;; having changed since we last used it.
(let (win)
(set-buffer (get-file-buffer file))
- (setq win (or verify-tags-table-function (initialize-new-tags-table)))
+ (setq win (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
(and verify-tags-table-function
(funcall verify-tags-table-function))
(revert-buffer t t)
- (initialize-new-tags-table)))
+ (tags-table-mode)))
(and (file-exists-p file)
(progn
(set-buffer (find-file-noselect file))
(setcar tail buffer-file-name))
(if (eq file tags-file-name)
(setq tags-file-name buffer-file-name))))
- (initialize-new-tags-table)))))
+ (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
(car list))
;; Finally, prompt the user for a file name.
(expand-file-name
- (read-file-name "Visit tags table: (default TAGS) "
+ (read-file-name "Visit tags table (default TAGS): "
default-directory
"TAGS"
t))))))
;; their tags included in the completion table.
(defun tags-completion-table ()
(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 a buffer-local variable.
+ (setq tags-completion-table combined-table))
(quit (message "Tags completion table construction aborted.")
(setq tags-completion-table nil)))))
;; XXX Kludge interface.
(define-button-type 'tags-select-tags-table
- 'action (lambda (button) (select-tags-table-select))
+ 'action 'select-tags-table-select
'help-echo "RET, t or mouse-2: select tags table")
;; XXX If a file is in multiple tables, selection may get the wrong one.
(desired-point nil)
b)
(when tags-table-list
- (setq desired-point (point-marker))
- (setq b (point))
- (princ tags-table-list (current-buffer))
- (make-text-button b (point) 'type 'tags-select-tags-table)
- (insert "\C-m")
- (prin1 (car tags-table-list) (current-buffer)) ;invisible
+ (setq desired-point (point-marker))
+ (setq b (point))
+ (princ (mapcar 'abbreviate-file-name tags-table-list) (current-buffer))
+ (make-text-button b (point) 'type 'tags-select-tags-table
+ 'etags-table (car tags-table-list))
(insert "\n"))
(while set-list
(unless (eq (car set-list) tags-table-list)
(setq b (point))
- (princ (car set-list) (current-buffer))
- (make-text-button b (point) 'type 'tags-select-tags-table)
- (insert "\C-m")
- (prin1 (car (car set-list)) (current-buffer)) ;invisible
+ (princ (mapcar 'abbreviate-file-name (car set-list)) (current-buffer))
+ (make-text-button b (point) 'type 'tags-select-tags-table
+ 'etags-table (car (car set-list)))
(insert "\n"))
(setq set-list (cdr set-list)))
(when tags-file-name
- (or desired-point
- (setq desired-point (point-marker)))
- (setq b (point))
- (insert tags-file-name)
- (make-text-button b (point) 'type 'tags-select-tags-table)
- (insert "\C-m")
- (prin1 tags-file-name (current-buffer)) ;invisible
+ (or desired-point
+ (setq desired-point (point-marker)))
+ (setq b (point))
+ (insert (abbreviate-file-name tags-file-name))
+ (make-text-button b (point) 'type 'tags-select-tags-table
+ 'etags-table tags-file-name)
(insert "\n"))
(setq set-list (delete tags-file-name
(apply 'nconc (cons (copy-sequence tags-table-list)
tags-table-set-list)))))
(while set-list
(setq b (point))
- (insert (car set-list))
- (make-text-button b (point) 'type 'tags-select-tags-table)
- (insert "\C-m")
- (prin1 (car set-list) (current-buffer)) ;invisible
+ (insert (abbreviate-file-name (car set-list)))
+ (make-text-button b (point) 'type 'tags-select-tags-table
+ 'etags-table (car set-list))
(insert "\n")
(setq set-list (delete (car set-list) set-list)))
(goto-char (point-min))
(select-tags-table-mode))
(defvar select-tags-table-mode-map
- (let ((map (copy-keymap button-buffer-map)))
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map button-buffer-map)
(define-key map "t" 'push-button)
(define-key map " " 'next-line)
(define-key map "\^?" 'previous-line)
(define-key map "q" 'select-tags-table-quit)
map))
-(defun select-tags-table-mode ()
+(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}"
- (interactive)
- (kill-all-local-variables)
- (setq buffer-read-only t
- major-mode 'select-tags-table-mode
- mode-name "Select Tags Table")
- (use-local-map select-tags-table-mode-map)
- (setq selective-display t
- selective-display-ellipses nil))
-
-(defun select-tags-table-select ()
+ (setq buffer-read-only t))
+
+(defun select-tags-table-select (button)
"Select the tags table named on this line."
- (interactive)
- (search-forward "\C-m")
- (let ((name (read (current-buffer))))
+ (interactive (list (or (button-at (line-beginning-position))
+ (error "No tags table on current line"))))
+ (let ((name (button-get button 'etags-table)))
(visit-tags-table name)
(select-tags-table-quit)
(message "Tags table now %s" name)))
(message "Making completion list...")
(with-output-to-temp-buffer "*Completions*"
(display-completion-list
- (all-completions pattern 'tags-complete-tag nil)))
+ (all-completions pattern 'tags-complete-tag nil)
+ pattern))
(message "Making completion list...%s" "done")))))
(dolist (x '("^No tags table in use; use .* to select one$"
\f
(provide 'etags)
-;;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e
+;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e
;;; etags.el ends here