From: gildea@expo.lcs.mit.edu (Stephen Gildea)
Subject: exact-tags.el - finds only tags that exactly match
Organization: Source only  Discussion and requests in gnu.emacs.help.
Distribution: gnu
Date: Tue, 29 Sep 1992 16:06:44 GMT

;;; exact-tags - finds only tags that exactly match what you ask for
;;; By Stephen Gildea <gildea@lcs.mit.edu> April 1992
;;; Time-stamp: <92/09/29 11:57:00 gildea>

;; Copyright (C) 1992 Free Software Foundation, Inc.

;; This file 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 1, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.


;;; Regular tags packages find a tag which contains the string you ask
;;; for, leading to many false matches.  This package finds only exact
;;; matches and never does case folding.

;;; Bugs: should be merged with harris-tag or some other
;;; many-featured tags package.

;;; Provides new versions of these tags functions:
;;; visit-tags-table-buffer -- to set the syntax table
;;; find-tag -- change the search to find only exact matches.

;;; To use, put this in your .emacs file:
;;; (autoload 'find-exact-tag "exact-tags"
;;;   "Find tag (in current tag table) whose name is exactly TAGNAME." t)
;;; (global-set-key "\M-." 'find-exact-tag)


(provide 'exact-tags)
(require 'tags)

;;; C and Lisp mode syntax tables makes it hard to write the regexp
;;; we need to be sure we are matching an entire identifier.
;;; So we simplify things by making all characters that could be
;;; in an identifier have "word" syntax.

(defvar exact-tags-syntax-table nil
  "Syntax table used by exact-tags for the TAGS file.")

(if exact-tags-syntax-table
    ()
    (setq exact-tags-syntax-table
	  (make-syntax-table c-mode-syntax-table))
    (modify-syntax-entry ?_ "w" exact-tags-syntax-table)
    (modify-syntax-entry ?- "w" exact-tags-syntax-table))

(defun visit-exact-tags-table-buffer ()
  "Select the buffer containing the current tag table.
This is a file whose name is in the variable tags-file-name."
  (or tags-file-name
      (call-interactively 'visit-tags-table))
  (set-buffer (or (get-file-buffer tags-file-name)
		  (progn
		    (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)
	     (setq tag-table-files nil))))
  (set-syntax-table exact-tags-syntax-table)
  (or (eq (char-after 1) ?\^L)
      (error "File %s not a valid tag table" tags-file-name)))

(defun find-exact-tag (tagname &optional next other-window)
  "Find tag (in current tag table) whose name is exactly TAGNAME.
Does not do case folding.
 Selects the buffer that the tag is contained in
and puts point at its definition.
 If TAGNAME is a null string, the expression in the buffer
around or before point is used as the tag name.
 If second arg NEXT is non-nil (interactively, with prefix arg),
searches for the next tag in the tag table
that matches the tagname used in the previous find-tag.

See documentation of variable tags-file-name."
  (interactive (if current-prefix-arg
		   '(nil t)
		 (find-tag-tag "Find tag: ")))
  (let (buffer file linebeg startpos)
    (save-excursion
     (visit-exact-tags-table-buffer)
     (if (not next)
	 (goto-char (point-min))
       (setq tagname last-tag))
     (setq last-tag tagname)
     (let ((case-fold-search nil))
       (while (progn
		(if (not (re-search-forward
			  (concat "\\<" (regexp-quote tagname) "\\>")
			  nil t))
		    (error "No %sentries containing %s"
			   (if next "more " "") tagname))
		(not (looking-at "[^\n\177]*\177")))))
     (search-forward "\177")
     (setq file (expand-file-name (file-of-tag)
				  (file-name-directory tags-file-name)))
     (setq linebeg
	   (buffer-substring (1- (point))
			     (save-excursion (beginning-of-line) (point))))
     (search-forward ",")
     (setq startpos (read (current-buffer))))
    (if other-window
	(find-file-other-window file)
      (find-file file))
    (widen)
    (push-mark)
    (let ((offset 1000)
	  (case-fold-search nil)
	  found
	  (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 (* 3 offset)))
      (or found
	  (re-search-forward pat nil t)
	  (error "%s not found in %s" pat file)))
    (beginning-of-line))
  (setq tags-loop-form '(find-tag nil t))
  ;; Return t in case used as the tags-loop-form.
  t)