[comp.emacs] completing find tag

kautz@allegra.UUCP (Henry Kautz) (09/07/88)

Here's an extension to the gnu Tag system, which allows name
completion on the find-tag commands.
	
---- Henry Kautz
:uucp:	allegra!kautz
:arpa/internet: kautz%allegra.att.com@research.att.com
:csnet: kautz%allegra.att.com@RELAY.CS.NET
	or	kautz%allegra@btl.csnet

-----------------------------------cut here-----------------------------
;;; Extension to GNU tag system
;;  New feature:
;;       tag name completion
;;  Created by Henry Kautz, AT&T Bell Labs
;;  May 2, 1988
;;  To use:  rebind keys to use
;;     completing-find-tag (instead of find-tag, by default on M-.)
;;     completing-find-tag-other-window 
;;                         (instead of find-tag-other-window,
;;                             by default on C-x-4-.)
;;  You do NOT need to explicitly build the tag completion table,
;;  this will happen automagically.
;;
;;; This file is not part of the GNU Emacs distribution (yet).
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; this file, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

(load-library "tags")
(provide 'build-tag-completion)
(provide 'tag-completion)

(defvar *tag-completion-table* nil)

(defun current-tag-completion-table ()
   "return the current tag completion table"
   (save-excursion (save-window-excursion (visit-tags-table-buffer)))
   *tag-completion-table*)
   

(defun build-tag-completion-table ()
   "Implicitly create *tag-completion-table*, based on current buffer"
   (goto-char (point-min))
   (setq *tag-completion-table* nil)
   (while (re-search-forward "^[^ ]+ +\\([^ ]+\\) " nil t)
      (setq *tag-completion-table* 
	 (cons (list (buffer-substring (match-beginning 1)
			(match-end 1))) *tag-completion-table*))
      )
   )

(defun build-tag-completion-command ()
   "Explicitly create *tag-completion-table*"
   (interactive)
   (save-excursion
      (save-window-excursion
	 (visit-tags-table-buffer)
	 (build-tag-completion-table)
	 )))

(defun completing-find-tag (tagname &optional next other-window)
   "better interface to find-tag"
   (interactive (if current-prefix-arg
		   '(nil t)
		   (let* ((default (find-tag-default))
			    (spec (completing-read
				     (if default
					(format "Find tag: (default %s) " 
					   default)
					"Find tag: ")
				     (current-tag-completion-table)
				     nil nil nil)))
		      (list (if (equal spec "")
			       default
			       spec)))))
   (find-tag tagname next other-window))

(defun completing-find-tag-other-window (tagname &optional next)
   "better interface to find-tag, uses other window"
   (interactive (if current-prefix-arg
		   '(nil t)
		   (let* ((default (find-tag-default))
			    (spec (completing-read
				     (if default
					(format 
				      "Find tag other window: (default %s) " 
					   default)
					"Find tag other window: ")
				     (current-tag-completion-table)
				     nil nil nil)))
		      (list (if (equal spec "")
			       default
			       spec)))))
   (find-tag tagname next t))

;;
;; visit-tags-table-buffer is modified to call build-tag-completion-table
;;
(defun visit-tags-table-buffer ()
   "Select the buffer containing the current tag table.
This is a file whose name is in the variable tags-file-name."
   ;; Modification
   (let (new-flag)
      (or tags-file-name
	 (call-interactively 'visit-tags-table))
      (set-buffer (or (get-file-buffer tags-file-name)
		     (progn
			;; Modification
			(setq new-flag t)
			(setq tag-table-files nil)
			(find-file-noselect tags-file-name))))
      (or (verify-visited-file-modtime (get-file-buffer tags-file-name))
	 (cond ((yes-or-no-p "Tags file has changed, read new contents? ")
		  (revert-buffer t t)
		  ;; Modification
		  (setq new-flag t)
		  (setq tag-table-files nil))))
      (or (eq (char-after 1) ?\^L)
	 (error "File %s not a valid tag table" tags-file-name))
      ;; Modification
      (if new-flag (build-tag-completion-table))))