etags

让find-tag首先定位当前buffer的tag

2 Comments

find-tag定位tag受到很多因素的影响，有时候希望它能首先定位到当前buffer的tag，但是它却跳到其它地方去了。如http://debbugs.gnu.org/cgi/bugreport.cgi?bug=2544描述的static函数是一个例子，另外就是为不同体系结构或者操作系统实现接口时使用相同的名字。如果我们注意到这种情况，那么只是操作上麻烦一点，倒还好说；如果没注意到，那么可能完全读错了代码，我在读Android Dalvik garbage collection的实现时就吃到了苦头。

为了解决这个问题，我对find-tag做了一点小小的改进，使其首先定位当前buffer的tag，这样就不会造成困惑。

方法很简单，首先从etags.el从复制出三个函数：find-tag、find-tag-noselect、以及find-tag-in-order，然后把他们重新命名为wl-etags-find-tag、wl-etags-find-tag-noselect和wl-etags-find-tag-in-order，并修改相应的调用点。最后把wl-etags-find-tag-in-order修改为下面的样子：

(defun wl-etags-get-from-buffer-file-name ()
  (let ((marker (ring-ref find-tag-marker-ring 0)))
    (with-current-buffer (marker-buffer marker)
      buffer-file-name)))

(defun wl-etags-goto-file (file)
  (let (beg)
    (while (and (search-forward "\f\n" nil t)
		(progn
		  (setq beg (point))
		  (end-of-line)
		  (skip-chars-backward "^," beg)
		  (or (looking-at "include$")
		      (not
		       (string-equal
			file
			(expand-file-name
			 (convert-standard-filename
			  (buffer-substring beg (1- (point)))))))))))))

;;; prefer tag in the same buffer as source buffer
(defun wl-etags-find-tag-in-order (pattern
				   search-forward-func
				   order
				   next-line-after-failure-p
				   matching
				   first-search)
  "Internal tag-finding function.
PATTERN is a string to pass to arg SEARCH-FORWARD-FUNC, and to any
member of the function list ORDER.  If ORDER is nil, use saved state
to continue a previous search.

Arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
point should be moved to the next line.

Arg MATCHING is a string, an English `-ing' word, to be used in an
error message."
  ;; Algorithm is as follows:
  ;; For each qualifier-func in ORDER, go to beginning of tags file, and
  ;; perform inner loop: for each naive match for PATTERN found using
  ;; SEARCH-FORWARD-FUNC, qualify the naive match using qualifier-func.  If
  ;; it qualifies, go to the specified line in the specified source file
  ;; and return.  Qualified matches are remembered to avoid repetition.
  ;; State is saved so that the loop can be continued.
  (let (file				;name of file containing tag
	tag-info			;where to find the tag in FILE
	(first-table t)
	(tag-order order)
	(match-marker (make-marker))
	goto-func
	(case-fold-search (if (memq tags-case-fold-search '(nil t))
			      tags-case-fold-search
			    case-fold-search))
	)
    (save-excursion

      (if first-search
	  ;; This is the start of a search for a fresh tag.
	  ;; Clear the list of tags matched by the previous search.
	  ;; find-tag-noselect has already put us in the first tags table
	  ;; buffer before we got called.
	  (setq tag-lines-already-matched nil)
	;; Continuing to search for the tag specified last time.
	;; tag-lines-already-matched lists locations matched in previous
	;; calls so we don't visit the same tag twice if it matches twice
	;; during two passes with different qualification predicates.
	;; Switch to the current tags table buffer.
	(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))

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

	  ;; Iterate over the list of ordering predicates.
	  (while order
	    ;; Only give one chance to tags in the from buffer here.
	    ;; They can be found later.
	    (when (and first-search first-table)
	      (let ((file (wl-etags-get-from-buffer-file-name)))
		(when file
		  (let* ((file-beg-pos (progn
					 (wl-etags-goto-file file)
					 (beginning-of-line)
					 (point)))
			 (file-end-pos (progn
					 (search-forward "\f\n" nil t)
					 (point))))
		    (goto-char file-beg-pos)

		    (while (funcall search-forward-func pattern file-end-pos t)
		      ;; 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 (point-at-bol))
					tag-lines-already-matched))
			   (throw 'qualified-match-found nil))
		      (if next-line-after-failure-p
			  (forward-line 1)))

		    ;; Nothing found.  Restart from the beginning.
		    (goto-char (point-min))))))

	    (while (funcall search-forward-func pattern nil t)
	      ;; 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 (point-at-bol))
				tag-lines-already-matched))
		   (throw 'qualified-match-found nil))
	      (if next-line-after-failure-p
		  (forward-line 1)))

	    ;; Try the next flavor of match.
	    (setq order (cdr order))
	    (goto-char (point-min)))
	  (setq first-table nil)
	  (setq order tag-order))
	;; We throw out on match, so only get here if there were no matches.
	;; Clear out the markers we use to avoid duplicate matches so they
	;; don't slow down editing and are immediately available for GC.
	(while tag-lines-already-matched
	  (set-marker (car tag-lines-already-matched) nil nil)
	  (setq tag-lines-already-matched (cdr tag-lines-already-matched)))
	(set-marker match-marker nil nil)
	(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 match-marker
					    tag-lines-already-matched))
      ;; Expand the filename, using the tags table buffer's default-directory.
      ;; We should be able to search for file-name backwards in file-of-tag:
      ;; the beginning-of-line is ok except when positioned on a "file-name" tag.
      (setq file (expand-file-name
		  (if (memq (car order) '(tag-exact-file-name-match-p
					  tag-file-name-match-p
					  tag-partial-file-name-match-p))
                      (save-excursion (forward-line 1)
                                      (file-of-tag))
                    (file-of-tag)))
	    tag-info (funcall snarf-tag-function))

      ;; Get the local value in the tags table buffer before switching buffers.
      (setq goto-func goto-tag-location-function)
      (tag-find-file-of-tag-noselect file)
      (widen)
      (push-mark)
      (funcall goto-func tag-info)

      ;; Return the buffer where the tag was found.
      (current-buffer))))

从实现上来说，并非完美的方案，有值得商榷的地方；从使用上来说，完美解决了我目前碰到的问题。:-)