comparison lisp/progmodes/etags.el @ 10661:32beb7b6dbf7

Changes to support filenames as tags too and provided a drop-in replacement for list-tags. (find-tag-noselect): Recognize filenames as valid tags too. (find-tag-file-order): New variable holds function to check for match for a file name used as a tag. (last-tag-file): New variable; stores the filename looked for via find-tag family of functions. (find-tag-in-order): If the tag is a file name, position at file beg. (etags-recognize-tags-table): Added new var find-tag-file-order to tags-table-format variables. Added tag-filename-match-p to the list for find-tag-tag-order. (tag-filename-match-p): New function. (list-tags): Rewritten for speed. (tags-list-functions-in-file): New subroutine for list-tags. (tags-locate-file-in-tags-table): New function locates a file in `tags-table-list'.

10660:0501556eef3a

(defvar snarf-tag-function nil
  "Function to get info about a matched tag for `goto-tag-location-function'.")
(defvar goto-tag-location-function nil
  "Function of to go to the location in the buffer specified by a tag.
One argument, the tag info returned by `snarf-tag-function'.")
(defvar find-tag-regexp-search-function nil
  "Search function passed to `find-tag-in-order' for finding a regexp tag.")
(defvar find-tag-regexp-tag-order nil
  "Tag order passed to `find-tag-in-order' for finding a regexp tag.")
(defvar find-tag-regexp-next-line-after-failure-p nil

		     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
  ;; fully-expanded name.
  (let ((tags-file-name file))
    (save-excursion
      (or (visit-tags-table-buffer file)
	  (signal 'file-error (list "Visiting tags table"

  (interactive (find-tag-interactive "Find tag: "))

  (setq find-tag-history (cons tagname find-tag-history))
  ;; Save the current buffer's value of `find-tag-hook' before selecting the
  ;; tags table buffer.
  (let ((local-find-tag-hook find-tag-hook))
    (if (eq '- next-p)
	;; Pop back to a previous location.
	(if (null tags-location-stack)
	    (error "No previous tag locations")
	  (let ((marker (car tags-location-stack)))

	;; Record TAGNAME for a future call with NEXT-P non-nil.
	(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 next-p 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")
	    (not next-p)))

	tag-info			;where to find the tag in FILE
	tags-table-file			;name of tags file
	(first-table t)
	(tag-order order)
	goto-func
	)
    (save-excursion
      (or first-search			;find-tag-noselect has already done it.
	  (visit-tags-table-buffer 'same))

      ;; Get a qualified match.
      (catch 'qualified-match-found

	;; Iterate over the list of tags tables.
	(while (or first-table
		   (visit-tags-table-buffer t))

	      (setq tag-lines-already-matched nil))

	  (and first-search first-table
	       ;; Start at beginning of tags file.
	       (goto-char (point-min)))
	  (setq first-table nil)

	  (setq tags-table-file buffer-file-name)
	  ;; Iterate over the list of ordering predicates.
	  (while order

	    (setq order (cdr order))
	    (goto-char (point-min)))
	  (setq order tag-order))
	;; We throw out on match, so only get here if there were no matches.
	(error "No %stags %s %s" (if first-search "" "more ")
	       matching pattern))
      
      ;; Found a tag; extract location info.
      (beginning-of-line)
      (setq tag-lines-already-matched (cons (point)
					    tag-lines-already-matched))

      ;; Find the right line in the specified file.
      (set-buffer (find-file-noselect file))
      (widen)
      (push-mark)
      (funcall goto-func tag-info)
      
      ;; Return the buffer where the tag was found.
      (current-buffer))))

;; `etags' TAGS file format support.

		 (goto-tag-location-function . etags-goto-tag-location)
		 (find-tag-regexp-search-function . re-search-forward)
		 (find-tag-regexp-tag-order . (tag-re-match-p))
		 (find-tag-regexp-next-line-after-failure-p . t)
		 (find-tag-search-function . search-forward)
		 (find-tag-tag-order . (tag-exact-match-p
					tag-symbol-match-p
					tag-word-match-p
					tag-any-match-p))
		 (find-tag-next-line-after-failure-p . nil)
		 (list-tags-function . etags-list-tags)
		 (tags-apropos-function . etags-tags-apropos)
		 (tags-included-tables-function . etags-tags-included-tables)
		 (verify-tags-table-function . etags-verify-tags-table)

(defun tag-word-match-p (tag)
  (and (looking-at "\\b.*\177")
       (save-excursion (backward-char (1+ (length tag)))
		       (looking-at "\\b"))))

;; t if point is in a tag line with a tag containing TAG as a substring.
(defun tag-any-match-p (tag)
  (looking-at ".*\177"))

;; t if point is at a tag line that matches RE as a regexp.

				   '(goto-char (match-beginning 0))))
	tags-loop-operate (list 'perform-replace from to t t delimited))
  (tags-loop-continue (or file-list-form t)))

;;;###autoload
(defun list-tags (file)
  "Display list of tags in file FILE.
FILE should not contain a directory specification."
  (interactive (list (completing-read "List tags in file: "
				      (save-excursion
					(visit-tags-table-buffer)
					(mapcar 'list
						(mapcar 'file-name-nondirectory
							(tags-table-files))))
				      nil t nil)))
  (with-output-to-temp-buffer "*Tags List*"
    (princ "Tags in file ")
    (princ file)
    (terpri)
    (save-excursion
      (let ((first-time t)
	    (gotany nil))
	(while (visit-tags-table-buffer (not first-time))
	  (setq first-time nil)
	  (if (funcall list-tags-function file)
	      (setq gotany t)))
	(or gotany
	    (error "File %s not in current tags tables" file))))))

;;;###autoload
(defun tags-apropos (regexp)
  "Display list of all tags in tags table REGEXP matches."
  (interactive "sTags apropos (regexp): ")

	      (all-completions pattern 'tags-complete-tag nil)))
	   (message "Making completion list...%s" "done")))))

;;;###autoload (define-key esc-map "\t" 'complete-tag)

(provide 'etags)

;;; etags.el ends here

10661:32beb7b6dbf7

(defvar snarf-tag-function nil
  "Function to get info about a matched tag for `goto-tag-location-function'.")
(defvar goto-tag-location-function nil
  "Function of to go to the location in the buffer specified by a tag.
One argument, the tag info returned by `snarf-tag-function'.")
(defvar find-tag-file-order nil
  "Function which checks for complete and correct match, for file name as tag.")
(defvar find-tag-regexp-search-function nil
  "Search function passed to `find-tag-in-order' for finding a regexp tag.")
(defvar find-tag-regexp-tag-order nil
  "Tag order passed to `find-tag-in-order' for finding a regexp tag.")
(defvar find-tag-regexp-next-line-after-failure-p nil

		     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
  ;; 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.
  (let ((tags-file-name file))
    (save-excursion
      (or (visit-tags-table-buffer file)
	  (signal 'file-error (list "Visiting tags table"

  (interactive (find-tag-interactive "Find tag: "))

  (setq find-tag-history (cons tagname find-tag-history))
  ;; Save the current buffer's value of `find-tag-hook' before selecting the
  ;; tags table buffer.
  (let ((local-find-tag-hook find-tag-hook)
	(search-tag))
    (if (eq '- next-p)
	;; Pop back to a previous location.
	(if (null tags-location-stack)
	    (error "No previous tag locations")
	  (let ((marker (car tags-location-stack)))

	;; Record TAGNAME for a future call with NEXT-P non-nil.
	(setq last-tag tagname))
      ;; Record the location so we can pop back to it later.
      (let ((marker (make-marker)))
	(save-excursion
	  (setq search-tag (if next-p last-tag tagname))
	  (set-buffer
	   ;; find-tag-in-order does the real work.
	   (find-tag-in-order
	    (if next-p last-tag tagname)
	    (if regexp-p
		find-tag-regexp-search-function
	      find-tag-search-function)
	    (if regexp-p
		find-tag-regexp-tag-order
	      (if (string-match "\\b.*\\.\\w*" search-tag)
		  find-tag-file-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")
	    (not next-p)))

	tag-info			;where to find the tag in FILE
	tags-table-file			;name of tags file
	(first-table t)
	(tag-order order)
	goto-func
	match-type
	)
    (save-excursion
      (or first-search			;find-tag-noselect has already done it.
	  (visit-tags-table-buffer 'same))

      ;; Get a qualified match.
      (setq match-type 
	    (catch 'qualified-match-found

	;; Iterate over the list of tags tables.
	(while (or first-table
		   (visit-tags-table-buffer t))

	      (setq tag-lines-already-matched nil))

	  (and first-search first-table
	       ;; Start at beginning of tags file.
	       (goto-char (point-min)))
	  (or first-table
	      (goto-char (point-min)))

	  (setq first-table nil)

	  (setq tags-table-file buffer-file-name)
	  ;; Iterate over the list of ordering predicates.
	  (while order

	    (setq order (cdr order))
	    (goto-char (point-min)))
	  (setq order tag-order))
	;; We throw out on match, so only get here if there were no matches.
	(error "No %stags %s %s" (if first-search "" "more ")
	       matching pattern)))
      
      ;; Found a tag; extract location info.
      (beginning-of-line)
      (setq tag-lines-already-matched (cons (point)
					    tag-lines-already-matched))

      ;; Find the right line in the specified file.
      (set-buffer (find-file-noselect file))
      (widen)
      (push-mark)
      (if (eq match-type 'tag-filename-match-p)
	  (goto-char (point-min))
	(funcall goto-func tag-info))
      
      ;; Return the buffer where the tag was found.
      (current-buffer))))

;; `etags' TAGS file format support.

		 (goto-tag-location-function . etags-goto-tag-location)
		 (find-tag-regexp-search-function . re-search-forward)
		 (find-tag-regexp-tag-order . (tag-re-match-p))
		 (find-tag-regexp-next-line-after-failure-p . t)
		 (find-tag-search-function . search-forward)
		 (find-tag-tag-order . (tag-filename-match-p
					tag-exact-match-p
					tag-symbol-match-p
					tag-word-match-p
					tag-any-match-p))
		 (find-tag-file-order . (tag-filename-match-p))
		 (find-tag-next-line-after-failure-p . nil)
		 (list-tags-function . etags-list-tags)
		 (tags-apropos-function . etags-tags-apropos)
		 (tags-included-tables-function . etags-tags-included-tables)
		 (verify-tags-table-function . etags-verify-tags-table)

(defun tag-word-match-p (tag)
  (and (looking-at "\\b.*\177")
       (save-excursion (backward-char (1+ (length tag)))
		       (looking-at "\\b"))))

(defun tag-filename-match-p (tag)
  (and (looking-at ",")
       (save-excursion (backward-char (1+ (length tag)))
		       (looking-at "\\b"))))

;; t if point is in a tag line with a tag containing TAG as a substring.
(defun tag-any-match-p (tag)
  (looking-at ".*\177"))

;; t if point is at a tag line that matches RE as a regexp.

				   '(goto-char (match-beginning 0))))
	tags-loop-operate (list 'perform-replace from to t t delimited))
  (tags-loop-continue (or file-list-form t)))

;;;###autoload
(defun list-tags (filename &optional next-match)
  "Gives the list of functions available in file \"filename\"
Searches only in \"tags-file-name\"."
  (interactive "sFunctions in File: ")
  (let (file-list)
    (setq file-list (tags-locate-file-in-tags-table filename
						    (if next-match next-match nil)))
    (if file-list
	(if (cdr file-list)
	    (select-tags-matched-file file-list 'extract-pos-and-tag-from-sel
				      'select-file-quit)
	  (tags-list-functions-in-file (nth 1 (car file-list))
				  (nth 2 (car file-list))))
      (message (format "%s not found in tags table" filename)))))

;;;###autoload
(defun tags-apropos (regexp)
  "Display list of all tags in tags table REGEXP matches."
  (interactive "sTags apropos (regexp): ")

	      (all-completions pattern 'tags-complete-tag nil)))
	   (message "Making completion list...%s" "done")))))

;;;###autoload (define-key esc-map "\t" 'complete-tag)

(defun tags-list-functions-in-file (pos tag-file)
   "Lists the functions for the given file.  Backend for `list-tags'."
   (let ((tag-buf (find-file-noselect tag-file))
       (result-buf (get-buffer-create "*Tags Function List*"))
       function
       beg
       map)
     (save-excursion
       (set-buffer result-buf)
       (erase-buffer)
       (set-buffer tag-buf)
       (goto-char pos)
       (forward-line 1)
       (beginning-of-line)
       ; C-l marks end of information of a file in TAGS.
       (while (and (not (looking-at "^\C-l")) (not (eobp)))
       ; skip mere #defines, typedefs and struct definitions
       (if (not (or (looking-at "^#define\\s-+[a-zA-Z0-9_]+\\s-+")
                    (looking-at "^typedef\\s-+")
                    (looking-at "^\\s-*}")))
           (progn
             (setq beg (point))
             (skip-chars-forward "^\C-?(")
             (setq function (buffer-substring beg (point)))
             (save-excursion
               (set-buffer result-buf)
               (insert (concat function "\n")))))
       (forward-line 1)
       (beginning-of-line)))
     (switch-to-buffer "*Tags Function List*")
     (goto-char 1)
     (set-buffer-modified-p nil)
     (setq buffer-read-only t)))

(defun tags-locate-file-in-tags-table (filename first-search)
  "This function is used to locate `filename' in `tags-table-list'.
 Its internally used by the functions `find-file-from-tags' and
 `tags-list-tags-in-file'.  If `first-search' is t, search continues from where 
 it left off last time.  Else, its a fresh search."
  (let (tag-list current-tags-buffer beg file found-file-list next-tag-file)
    (setq tag-list tags-table-list)
    (catch 'found-file
      (setq found-file-list nil
	    next-tag-file nil)
      (while tag-list
	(setq current-tags-buffer (find-file-noselect (car tag-list)))
	(save-excursion
	  (set-buffer current-tags-buffer)
	  (if (or next-tag-file
		  (not first-search))
	      (goto-char (point-min)))
	  (if (search-forward filename nil t)
	      (if (tag-filename-match-p filename)
		  (progn
		    (beginning-of-line)
		    (setq beg (point))
		    (skip-chars-forward "^,")
		    (or (looking-at ",include$")
			(setq file (expand-file-name (buffer-substring beg
								       (point)))))
		    (if (string-match filename (file-name-nondirectory file))
			(progn
			  (setq found-file-list (cons (list file (point)
							    (buffer-file-name))
						      found-file-list))
			  (throw 'found-file found-file-list))))))
	  (setq tag-list (cdr tag-list))
	  (setq next-tag-file 't)))
      (throw 'found-file found-file-list))))

(provide 'etags)

;;; etags.el ends here