[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: patch: add-log.el: changelog find file under point
|
From: |
martin rudalics |
|
Subject: |
Re: patch: add-log.el: changelog find file under point |
|
Date: |
Mon, 18 Feb 2008 20:46:57 +0100 |
|
User-agent: |
Mozilla Thunderbird 1.0 (Windows/20041206) |
I've now designed two approaches to handle this. The user interface is
the same: Move to some `change-log-list' item and type C-c C-t. The
corresponding part of the source should be displayed in another window.
The simple approach is based on searching and comparing the result with
that of `add-log-current-defun'. It works pretty well most of the time
but may exhibit the nasty behavior described in
http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00443.html
On my 1 GHz machine this means that I have to wait some 40 secs until
I'm told that there are no matches. I can think of two ways to handle
this: (1) Convince Alan that the behavior of `c-beginning-of-defun' is
intolerable - AFAICT this has been tried before. (2) Fix this within
`add-log-current-defun' to not use `c-beginning-of-defun' - I'm unable
to do this myself because I completely fail to understand that part of
the function.
I've attached the simple approach as add-log-simple.patch.
The more complicated approach is based on a combination of imenu, etags,
and regexp searching. I've put most of this in a separate file called
local-tags.el merely because it would allow me to fix `which-func-mode'
and `imenu' as well (both are currently not really useful for c-mode).
This approach is more reliable and works faster for c-mode files. It
requires, however, to have etags installed and working in order to get
reasonable behavior for c-mode change logs.
The second approach is attached as add-log-tags.patch and local-tags.el.
Note that add-log.el has (require 'local-tags) here, hence you have to
make sure that the latter is found.
*** add-log.el.~1.205.~ Sun Jan 27 20:52:46 2008
--- add-log.el Mon Feb 18 20:00:22 2008
***************
*** 300,309 ****
;; name.
(progn
(re-search-forward change-log-file-names-re nil t)
! (match-string 2))
(if (looking-at change-log-file-names-re)
;; We found a file name.
! (match-string 2)
;; Look backwards for either a file name or the log entry start.
(if (re-search-backward
(concat "\\(" change-log-start-entry-re
--- 300,309 ----
;; name.
(progn
(re-search-forward change-log-file-names-re nil t)
! (match-string-no-properties 2))
(if (looking-at change-log-file-names-re)
;; We found a file name.
! (match-string-no-properties 2)
;; Look backwards for either a file name or the log entry start.
(if (re-search-backward
(concat "\\(" change-log-start-entry-re
***************
*** 314,324 ****
;; file name.
(progn
(re-search-forward change-log-file-names-re nil t)
! (match-string 2))
! (match-string 4))
;; We must be before any file name, look forward.
(re-search-forward change-log-file-names-re nil t)
! (match-string 2))))))
(defun change-log-find-file ()
"Visit the file for the change under point."
--- 314,324 ----
;; file name.
(progn
(re-search-forward change-log-file-names-re nil t)
! (match-string-no-properties 2))
! (match-string-no-properties 4))
;; We must be before any file name, look forward.
(re-search-forward change-log-file-names-re nil t)
! (match-string-no-properties 2))))))
(defun change-log-find-file ()
"Visit the file for the change under point."
***************
*** 328,338 ****
--- 328,523 ----
(find-file file)
(message "No such file or directory: %s" file))))
+ (defun change-log-search-tag-name-1 (&optional from)
+ "Search for a tag name within subexpression 1 of last match.
+ Optional argument FROM specifies a buffer position where the tag
+ name should be located. Return value is a cons whose car is the
+ string representing the tag and whose cdr is the position where
+ the tag was found."
+ (save-restriction
+ (narrow-to-region (match-beginning 1) (match-end 1))
+ (when from (goto-char from))
+ ;; The regexp below skips any symbol near `point' (FROM) followed by
+ ;; whitespace and another symbol. This should skip, for example,
+ ;; "struct" in a specification like "(struct buffer)" and move to
+ ;; "buffer". A leading paren is ignored.
+ (when (looking-at
+ "[(]?\\(?:\\(?:\\sw\\|\\s_\\)+\\(?:[ \t]+\\(\\sw\\|\\s_\\)+\\)\\)")
+ (goto-char (match-beginning 1)))
+ (cons (find-tag-default) (point))))
+
+ (defconst change-log-tag-re
+ "(\\(\\(?:\\sw\\|\\s_\\)+\\(?:[, \t]+\\(?:\\sw\\|\\s_\\)+\\)*\\))"
+ "Regexp matching a tag name in change log entries.")
+
+ (defun change-log-search-tag-name (&optional at)
+ "Search for a tag name near `point'.
+ Optional argument AT non-nil means search near buffer position
+ AT. Return value is a cons whose car is the string representing
+ the tag and whose cdr is the position where the tag was found."
+ (save-excursion
+ (goto-char (setq at (or at (point))))
+ (save-restriction
+ (widen)
+ (or (condition-case nil
+ ;; Within parenthesized list?
+ (save-excursion
+ (backward-up-list)
+ (when (looking-at change-log-tag-re)
+ (change-log-search-tag-name-1 at)))
+ (error nil))
+ (condition-case nil
+ ;; Before parenthesized list?
+ (save-excursion
+ (when (and (skip-chars-forward " \t")
+ (looking-at change-log-tag-re))
+ (change-log-search-tag-name-1)))
+ (error nil))
+ (condition-case nil
+ ;; Near filename?
+ (save-excursion
+ (when (and (progn
+ (beginning-of-line)
+ (looking-at change-log-file-names-re))
+ (goto-char (match-end 0))
+ (skip-syntax-forward " ")
+ (looking-at change-log-tag-re))
+ (change-log-search-tag-name-1)))
+ (error nil))
+ (condition-case nil
+ ;; Before filename?
+ (save-excursion
+ (when (and (progn
+ (skip-syntax-backward " ")
+ (beginning-of-line)
+ (looking-at change-log-file-names-re))
+ (goto-char (match-end 0))
+ (skip-syntax-forward " ")
+ (looking-at change-log-tag-re))
+ (change-log-search-tag-name-1)))
+ (error nil))
+ (condition-case nil
+ ;; Near start entry?
+ (save-excursion
+ (when (and (progn
+ (beginning-of-line)
+ (looking-at change-log-start-entry-re))
+ (forward-line) ; Won't work for multiple
+ ; names, etc.
+ (skip-syntax-forward " ")
+ (progn
+ (beginning-of-line)
+ (looking-at change-log-file-names-re))
+ (goto-char (match-end 0))
+ (re-search-forward change-log-tag-re))
+ (change-log-search-tag-name-1)))
+ (error nil))
+ (condition-case nil
+ ;; After parenthesized list?.
+ (when (re-search-backward change-log-tag-re)
+ (save-restriction
+ (narrow-to-region (match-beginning 1) (match-end 1))
+ (goto-char (point-max))
+ (cons (find-tag-default) (point-max))))
+ (error nil))))))
+
+ (defvar change-log-find-head nil)
+ (defvar change-log-find-tail nil)
+
+ (defun change-log-find-tag-1 (tag regexp file buffer
+ &optional window first last)
+ "Search for tag TAG in buffer BUFFER visiting file FILE.
+ REGEXP is a regular expression for TAG. The remaining arguments
+ are optional: WINDOW denotes the window to display the results of
+ the search. FIRST is a position in BUFFER denoting the first
+ match from previous searches for TAG. LAST is the position in
+ BUFFER denoting the last match for TAG in the last search."
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (if last
+ (progn
+ ;; When LAST is set make sure we continue from the next
+ ;; line end to not find the same tag again.
+ (goto-char last)
+ (end-of-line)
+ (condition-case nil
+ ;; Try to go to the end of the current defun to avoid
+ ;; false positives within the current defun's body
+ ;; since these would match `add-log-current-defun'.
+ (end-of-defun)
+ ;; Don't fall behind when `end-of-defun' fails.
+ (error (progn (goto-char last) (end-of-line))))
+ (setq last nil))
+ ;; When LAST was not set start at beginning of BUFFER.
+ (goto-char (point-min)))
+ (let (current-defun)
+ (while (and (not last) (re-search-forward regexp nil t))
+ ;; Verify that `add-log-current-defun' invoked at the end
+ ;; of the match returns TAG. This heuristic works well
+ ;; whenever the name of the defun occurs within the first
+ ;; line of the defun.
+ (setq current-defun (add-log-current-defun))
+ (when (and current-defun (string-equal current-defun tag))
+ ;; Record this as last match.
+ (setq last (line-beginning-position))
+ ;; Record this as first match when there's none.
+ (unless first (setq first last)))))))
+ (if (or last first)
+ (with-selected-window (or window (display-buffer buffer))
+ (if last
+ (progn
+ (when (or (< last (point-min)) (> last (point-max)))
+ ;; Widen to show TAG.
+ (widen))
+ (push-mark)
+ (goto-char last))
+ ;; When there are no more matches go (back) to FIRST.
+ (message "No more matches for `%s' in %s" tag file)
+ (setq last first)
+ (goto-char first))
+ ;; Return new "tail".
+ (list (selected-window) first last))
+ (message "Not found `%s' in %s" tag file)
+ nil)))
+
+ (defun change-log-find-tag ()
+ "Find source code for change log tag near `point'.
+ A tag is a symbol within a parenthesized, comma-separated list."
+ (interactive)
+ (if (and (eq last-command 'change-log-find-tag)
+ change-log-find-tail)
+ (setq change-log-find-tail
+ (condition-case nil
+ (apply 'change-log-find-tag-1
+ (append change-log-find-head change-log-find-tail))
+ (error
+ (format "Cannot find more matches for `%s' in %s"
+ (car change-log-find-head)
+ (nth 2 change-log-find-head)))))
+ (save-excursion
+ (let* ((tag-at (change-log-search-tag-name))
+ (tag (car tag-at))
+ (file (when tag-at
+ (change-log-search-file-name (cdr tag-at)))))
+ (if (not tag)
+ (error "No suitable tag near `point'")
+ (setq change-log-find-head
+ (list tag (concat "\\_<" (regexp-quote tag) "\\_>")
+ file (find-file-noselect file)))
+ (condition-case nil
+ (setq change-log-find-tail
+ (apply 'change-log-find-tag-1 change-log-find-head))
+ (error (format "Cannot find matches for `%s' in %s"
+ tag file))))))))
+
(defvar change-log-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment)
(define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment)
(define-key map [?\C-c ?\C-f] 'change-log-find-file)
+ (define-key map [?\C-c ?\C-t] 'change-log-find-tag)
map)
"Keymap for Change Log major mode.")
***************
*** 938,944 ****
having-next-defun
previous-defun-end
next-defun-beginning)
!
(save-excursion
(setq having-previous-defun
(c-beginning-of-defun))
--- 1123,1129 ----
having-next-defun
previous-defun-end
next-defun-beginning)
!
(save-excursion
(setq having-previous-defun
(c-beginning-of-defun))
*** add-log.el.~1.205.~ Sun Jan 27 20:52:46 2008
--- add-log.el Mon Feb 18 18:45:28 2008
***************
*** 300,309 ****
;; name.
(progn
(re-search-forward change-log-file-names-re nil t)
! (match-string 2))
(if (looking-at change-log-file-names-re)
;; We found a file name.
! (match-string 2)
;; Look backwards for either a file name or the log entry start.
(if (re-search-backward
(concat "\\(" change-log-start-entry-re
--- 300,309 ----
;; name.
(progn
(re-search-forward change-log-file-names-re nil t)
! (match-string-no-properties 2))
(if (looking-at change-log-file-names-re)
;; We found a file name.
! (match-string-no-properties 2)
;; Look backwards for either a file name or the log entry start.
(if (re-search-backward
(concat "\\(" change-log-start-entry-re
***************
*** 314,324 ****
;; file name.
(progn
(re-search-forward change-log-file-names-re nil t)
! (match-string 2))
! (match-string 4))
;; We must be before any file name, look forward.
(re-search-forward change-log-file-names-re nil t)
! (match-string 2))))))
(defun change-log-find-file ()
"Visit the file for the change under point."
--- 314,324 ----
;; file name.
(progn
(re-search-forward change-log-file-names-re nil t)
! (match-string-no-properties 2))
! (match-string-no-properties 4))
;; We must be before any file name, look forward.
(re-search-forward change-log-file-names-re nil t)
! (match-string-no-properties 2))))))
(defun change-log-find-file ()
"Visit the file for the change under point."
***************
*** 328,338 ****
--- 328,487 ----
(find-file file)
(message "No such file or directory: %s" file))))
+ (defun change-log-search-tag-name-1 (&optional from)
+ "Search for a tag name within subexpression 1 of last match.
+ Optional argument FROM specifies a buffer position where the tag
+ name should be located. Return value is a cons whose car is the
+ string representing the tag and whose cdr is the position where
+ the tag was found."
+ (save-restriction
+ (narrow-to-region (match-beginning 1) (match-end 1))
+ (when from (goto-char from))
+ ;; The regexp below skips any symbol near `point' (FROM) followed by
+ ;; whitespace and another symbol. This should skip, for example,
+ ;; "struct" in a specification like "(struct buffer)" and move to
+ ;; "buffer". A leading paren is ignored.
+ (when (looking-at
+ "[(]?\\(?:\\(?:\\sw\\|\\s_\\)+\\(?:[ \t]+\\(\\sw\\|\\s_\\)+\\)\\)")
+ (goto-char (match-beginning 1)))
+ (cons (find-tag-default) (point))))
+
+ (defconst change-log-tag-re
+ "(\\(\\(?:\\sw\\|\\s_\\)+\\(?:[, \t]+\\(?:\\sw\\|\\s_\\)+\\)*\\))"
+ "Regexp matching a tag name in change log entries.")
+
+ (defun change-log-search-tag-name (&optional at)
+ "Search for a tag name near `point'.
+ Optional argument AT non-nil means search near buffer position
+ AT. Return value is a cons whose car is the string representing
+ the tag and whose cdr is the position where the tag was found."
+ (save-excursion
+ (goto-char (setq at (or at (point))))
+ (save-restriction
+ (widen)
+ (or (condition-case nil
+ ;; Within parenthesized list?
+ (save-excursion
+ (backward-up-list)
+ (when (looking-at change-log-tag-re)
+ (change-log-search-tag-name-1 at)))
+ (error nil))
+ (condition-case nil
+ ;; Before parenthesized list?
+ (save-excursion
+ (when (and (skip-chars-forward " \t")
+ (looking-at change-log-tag-re))
+ (change-log-search-tag-name-1)))
+ (error nil))
+ (condition-case nil
+ ;; Near filename?
+ (save-excursion
+ (when (and (progn
+ (beginning-of-line)
+ (looking-at change-log-file-names-re))
+ (goto-char (match-end 0))
+ (skip-syntax-forward " ")
+ (looking-at change-log-tag-re))
+ (change-log-search-tag-name-1)))
+ (error nil))
+ (condition-case nil
+ ;; Before filename?
+ (save-excursion
+ (when (and (progn
+ (skip-syntax-backward " ")
+ (beginning-of-line)
+ (looking-at change-log-file-names-re))
+ (goto-char (match-end 0))
+ (skip-syntax-forward " ")
+ (looking-at change-log-tag-re))
+ (change-log-search-tag-name-1)))
+ (error nil))
+ (condition-case nil
+ ;; Near start entry?
+ (save-excursion
+ (when (and (progn
+ (beginning-of-line)
+ (looking-at change-log-start-entry-re))
+ (forward-line) ; Won't work for multiple
+ ; names, etc.
+ (skip-syntax-forward " ")
+ (progn
+ (beginning-of-line)
+ (looking-at change-log-file-names-re))
+ (goto-char (match-end 0))
+ (re-search-forward change-log-tag-re))
+ (change-log-search-tag-name-1)))
+ (error nil))
+ (condition-case nil
+ ;; After parenthesized list?.
+ (when (re-search-backward change-log-tag-re)
+ (save-restriction
+ (narrow-to-region (match-beginning 1) (match-end 1))
+ (goto-char (point-max))
+ (cons (find-tag-default) (point-max))))
+ (error nil))))))
+
+ (defvar change-log-tag-buffer nil
+ "Buffer visiting source file for last call of `change-log-find-tag'.")
+
+ (defvar change-log-tag-list nil
+ "List of matches found by last call of `change-log-find-tag'.
+ When matches exist a cons cell whose caar denotes the function to
+ call for going to a matching location and whose cdr is the list
+ of locations.")
+
+ (defvar change-log-tag-arg nil
+ "Index used for rotating `change-log-tag-list'.")
+
+ (defun change-log-find-tag ()
+ "Display source code matching change log entry near `point'.
+ Invoking this repeatedly will rotate through matches found."
+ (interactive)
+ (save-excursion
+ (if (equal last-command 'change-log-find-tag)
+ ;; Rotate hits.
+ (if (or (not change-log-tag-buffer) (null change-log-tag-list))
+ (message "No matches to display")
+ (setq change-log-tag-arg (1+ change-log-tag-arg))
+ (when (= change-log-tag-arg (length (cdr change-log-tag-list)))
+ (when (> (length (cdr change-log-tag-list)) 1)
+ (message "Wrapping to first match")) ; Inform user.
+ (setq change-log-tag-arg 0))
+ (let ((fun (caar change-log-tag-list))
+ (hit (nth change-log-tag-arg (cdr change-log-tag-list))))
+ (with-selected-window (display-buffer change-log-tag-buffer)
+ (push-mark nil t)
+ (funcall fun hit))))
+ ;; Get new hits.
+ (let* ((tag-at (change-log-search-tag-name))
+ (tag (car tag-at))
+ (file (when tag-at
+ (change-log-search-file-name (cdr tag-at)))))
+ (if (not tag)
+ (error "No suitable tag name near `point'")
+ (set (make-local-variable 'change-log-tag-buffer)
+ (find-file-noselect file))
+ (require 'local-tags)
+ (set (make-local-variable 'change-log-tag-list)
+ (with-current-buffer change-log-tag-buffer
+ (local-tags-find tag)))
+ (if (null change-log-tag-list)
+ (message "No matches for `%s' in %s" tag file)
+ (when (> (length (cdr change-log-tag-list)) 1)
+ (message "Repeat this command to display more matches"))
+ (set (make-local-variable 'change-log-tag-arg) 0)
+ (let ((fun (caar change-log-tag-list))
+ (hit (cadr change-log-tag-list)))
+ (with-selected-window (display-buffer change-log-tag-buffer)
+ (push-mark nil t)
+ (funcall fun hit)))))))))
+
(defvar change-log-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment)
(define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment)
(define-key map [?\C-c ?\C-f] 'change-log-find-file)
+ (define-key map [?\C-c ?\C-t] 'change-log-find-tag)
map)
"Keymap for Change Log major mode.")
***************
*** 938,944 ****
having-next-defun
previous-defun-end
next-defun-beginning)
!
(save-excursion
(setq having-previous-defun
(c-beginning-of-defun))
--- 1087,1093 ----
having-next-defun
previous-defun-end
next-defun-beginning)
!
(save-excursion
(setq having-previous-defun
(c-beginning-of-defun))
;;; local-tags.el --- buffer-local tags
;; Copyright (C) 2008 Martin Rudalics
;; Time-stamp: "2008-02-18 20:41:11 martin"
;; Author: Martin Rudalics <address@hidden>
;; Keywords: tags, imenu, etags
;; GNU Emacs 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 3, or (at your option)
;; any later version.
;; GNU Emacs 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, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
(defgroup local-tags nil
"Buffer-local tags."
:version "23.1"
:group 'convenience)
(defcustom local-tags-methods '(imenu etags syntax plain)
"List of methods for extracting tags of current buffer.
Possible members are:
`imenu': Apply the method used by imenu for creating this buffer's
index (`imenu--index-alist').
`etags': Run the `etags' program on the contents of this buffer.
`plain': Plain search (ignored when listing tags).
`syntax': Like plain search but do not report matches within
comments or strings (ignored when listing tags).
The methods in this list are run until one of them reports a
result. This variable can be set in a hook, as
(add-hook 'c-mode-hook
(set (make-local-variable 'local-tags-methods)
'(etags imenu syntax plain)))"
:type '(repeat (choice (const :tag "imenu" imenu)
(const :tag "etags" etags)
(const :tag "syntactic search" syntax)
(const :tag "plain search" plain)))
:group 'local-tags)
(defcustom local-tags-revert-buffer nil
"Non-nil means revert buffer when visited file chenged on disk."
:type 'boolean
:group 'local-tags)
(defcustom local-tags-etags-program "etags"
"Name of etags program."
:type 'string
:group 'local-tags)
(defcustom local-tags-etags-options '("--no-members")
"List of options passed to etags program.
Possible options are \"--declarations\", \"-D\", \"-I\",
\"--no-globals\", and \"--no-members\".
Do not specify \"-o\", \"--output\", or \"--parse-stdin\" here,
they are passed to etags automatically."
:type '(repeat (string :tag "Option"))
:group 'local-tags)
(defcustom local-tags-etags-charpos nil
"Non-nil means etags based functions report character positions.
The default has etags based functions report line numbers which
is slower when actually going to the tag but more reliable
because the etags program reports file position which might not
always translate correctly to buffer positions."
:type 'boolean
:group 'local-tags)
;; imenu specific part.
(defvar local-tags-imenu-tag-list nil
"Tags created by `local-tags-imenu-list'.")
(make-variable-buffer-local 'local-tags-imenu-tag-list)
(defun local-tags-imenu-list ()
"Retrieve tags for current buffer using imenu.
Return nil or a cons cell whose car is a list built of the symbol
`goto-char' and the `buffer-chars-modified-tick' value at the
time this list was created. The cdr of the cons is the list of
tags created by `imenu-create-index-function' for this buffer."
(if (and (local-variable-p 'local-tags-imenu-tag-list)
(= (nth 1 (car local-tags-imenu-tag-list))
(buffer-chars-modified-tick)))
;; We have a valid `local-tags-imenu-tag-list', return it.
local-tags-imenu-tag-list
;; `local-tags-imenu-tag-list' either doesn't exist yet or the
;; buffer has been modified since it was created; (re-)build it.
(require 'imenu)
;; Don't use markers for our purposes.
(let (imenu-use-markers)
(save-excursion
(save-restriction
(widen)
(let ((tags (condition-case nil
;; Calculate the tags.
(funcall imenu-create-index-function)
(error nil))))
;; Prepend `goto-char' and `buffer-chars-modified-tick' and
;; save the result in `local-tags-imenu-tag-list'.
(setq local-tags-imenu-tag-list
(when tags
(cons (list 'goto-char (buffer-chars-modified-tick))
tags)))))))))
(defun local-tags-imenu-find-1 (tags tag)
"Return list of all matches for TAG in tag-list TAGS.
TAGS is assumed to be an object created by calling
`imenu-create-index-function'."
(let (hits)
(dolist (item tags)
(cond
((number-or-marker-p (cdr item))
;; A useful item, return as is.
(when (equal (car item) tag)
(setq hits (cons (cdr item) hits))))
((listp (cdr item))
;; Recurse.
(setq hits (nconc (local-tags-imenu-find-1 (cdr item) tag)
hits)))))
hits))
(defun local-tags-imenu-find (tag)
"Return matches for tag TAG in current buffer using imenu.
Return nil or a cons cell whose car is a list built of the symbol
`goto-char' and the `buffer-chars-modified-tick' value at the
time a list of tags was created for this buffer. The cdr of the
cons is a list of locations matching TAG."
(condition-case nil
;; Update `local-tags-imenu-tag-list' if necessary.
(let ((tags (local-tags-imenu-list)))
(when tags
(let ((hits (local-tags-imenu-find-1 (cdr tags) tag)))
(when hits
(cons (car tags)
;; `local-tags-imenu-find-1' returns hits in descending
;; order, reverse them.
(nreverse hits))))))
(error nil)))
;; etags specific part.
(defvar local-tags-etags-buffer nil
"Buffer used for storing etags output.")
(defvar local-tags-etags-tag-list nil
"Tags created by `local-tags-etags-list'.")
(make-variable-buffer-local 'local-tags-etags-tag-list)
;; We use an adaption of the regexp from Roland McGrath's
;; `etags-tags-completion-table', where
;; 1 is the "guessed" tag name,
;; 2 the "explicitly specified" tag name,
;; 3 the number of the line where the tag appears, and
;; 4 (usually) the tag's line beginning position (minus 1).
(defconst local-tags-etags-regexp
"^\\(?:\\(?:[^\177]+[^-a-zA-Z0-9_+*$:\177]+\\)?\
\\([-a-zA-Z0-9_+*$?:]+\\)[^-a-zA-Z0-9_+*$?:\177]*\\)\177\
\\(?:\\([^\n\001]+\\)\001\\)?\\([0-9]+\\)?,\\([0-9]+\\)?\n"
"Regexp to search for tags in etags generated buffers.")
;; Note: Maybe we should consider customizing which matches may be
;; reported for etags regexp (only guessed, only explicitly specified,
;; currently it's either of them when they differ).
(defun local-tags-etags-list ()
"Retrieve tags for current buffer using etags.
Return nil or a cons cell whose car is a list built of the
function to go to the tag, the `buffer-chars-modified-tick' value
at the time this list was created, and the values of
`local-tags-etags-options' and `local-tags-etags-charpos' used
for running etags. The cdr of the cons is the list of tags
obtained by running `local-tags-etags-program' on this buffer."
(if (and (local-variable-p 'local-tags-etags-tag-list)
(= (nth 1 (car local-tags-etags-tag-list))
(buffer-chars-modified-tick))
(equal (nth 2 (car local-tags-etags-tag-list))
local-tags-etags-options)
(equal (nth 3 (car local-tags-etags-tag-list))
local-tags-etags-charpos))
;; We have a valid `local-tags-etags-tag-list', return it.
local-tags-etags-tag-list
;; `local-tags-etags-tag-list' either doesn't exist yet, or the
;; buffer has been modified since it was created, or some options
;; for running etags have changed; (re-)build it.
(unless local-tags-etags-buffer
;; There's no buffer for etags output, create one.
(setq local-tags-etags-buffer
;; FIXME: Prepend space to make this buffer invisible.
(generate-new-buffer "*local-tags*")))
;; Clean the buffer for etags output.
(with-current-buffer local-tags-etags-buffer
(erase-buffer))
;; Run etags on entire buffer.
(save-restriction
(widen)
(apply 'call-process-region (point-min) (point-max)
local-tags-etags-program nil local-tags-etags-buffer nil
(append
(list
"--output=-" (concat "--parse-stdin=" (buffer-name)))
local-tags-etags-options)))
;; Build the tags-list. Make sure to apply the correct value of
;; `local-tags-etags-charpos' in case this has been made local in
;; the current buffer.
(let ((position local-tags-etags-charpos)
tags ms1 ms2 location)
(with-current-buffer local-tags-etags-buffer
(goto-char (point-min))
(while (re-search-forward local-tags-etags-regexp nil t)
;; When we record character positions add one to the value
;; returned by etags since the latter counts file positions
;; from zero.
(setq location
(if position
(1+ (string-to-number
(match-string-no-properties 4)))
(string-to-number
(match-string-no-properties 3))))
(when (setq ms1 (match-string-no-properties 1))
;; We have a match for the "guessed" tag, record it.
(setq tags (cons (cons ms1 location) tags)))
(when (and (setq ms2 (match-string-no-properties 2))
(or (not ms1) (not (string-equal ms1 ms2))))
;; We have a match for the "explicitly specified" tag and
;; its name does not coincide with that of the "guessed"
;; tag, record it.
(setq tags (cons (cons ms2 location) tags)))))
;; Prepend the goto function, `buffer-chars-modified-tick', and
;; the relevant options for running etags, and save the result in
;; `local-tags-etags-tag-list'.
(setq local-tags-etags-tag-list
(when tags
(cons
(list
(if local-tags-etags-charpos 'goto-char 'goto-line)
(buffer-chars-modified-tick)
local-tags-etags-options local-tags-etags-charpos)
;; List tags in ascending buffer positions.
(nreverse tags)))))))
(defun local-tags-etags-find (tag)
"Return matches for tag TAG in current buffer using etags.
Return nil or a cons cell whose car is a list built of the
function to go to tag locations, the `buffer-chars-modified-tick'
value at the time this list was created, and the values of
`local-tags-etags-options' and `local-tags-etags-charpos' used
for running etags. The cdr of the cons is a list of locations of
tags matching TAG."
(condition-case nil
;; Update `local-tags-etags-tag-list' if necessary.
(let ((tags (local-tags-etags-list)))
(when tags
(let (hits)
(dolist (item (cdr tags))
(when (string-equal (car item) tag)
(setq hits (cons (cdr item) hits))))
(when hits
(cons (car tags) (nreverse hits))))))
(error nil)))
;; Regexp search.
(defun local-tags-regexp-find (tag &optional syntax)
"Return matches for tag TAG in current buffer by searching.
Return nil or a cons cell whose car is a list built of the symbol
`goto-char'. The cdr of the cons is a list of beginning
positions for each buffer line containing a symbol matching TAG.
Optional argument SYNTAX non-nil means don't report matches
within comments or strings."
;; TAG must be a symbol according to the current symbol table.
(let ((regexp (concat "\\_<" (regexp-quote tag) "\\_>"))
hit hits end state)
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
;; Save `match-end' since `syntax-ppss' may clobber it.
(setq end (match-end 0))
(unless (and syntax
(setq state (syntax-ppss end))
(or (nth 3 state) (nth 4 state)))
(setq hit (line-beginning-position))
(unless (and hits (= hit (car hits)))
;; Don't record a hit if we have already recorded its
;; `line-beginning-position'.
(setq hits (cons (line-beginning-position) hits))))
(goto-char end))))
(when hits
;; Prepend `goto-char' and reverse hits.
(cons (list 'goto-char) (nreverse hits)))))
;; List tags for current buffer.
(defun local-tags-list (&optional overriding-methods)
"Return tags for current buffer.
The list of methods tried to find tags is specified by the
variable `local-tags-methods'. Alternatively, optional argument
`overriding-methods' can be used to specify the list of methods.
Return nil when no tags have been found. Otherwise, return a
cons whose caar denotes the function to call for going to a tag
and whose cdr is the list of tags returned by the respective
method. Each entry of that list is a cons cell whose car is the
name of the tag and whose cdr is the location of the tag."
(interactive)
;; Maybe revert buffer.
(when (and local-tags-revert-buffer
(file-exists-p (buffer-file-name))
(not (verify-visited-file-modtime (current-buffer))))
(revert-buffer)) ; Maybe we should preserve modes here?
(let (tags)
(catch 'tags
;; Run methods until one of them gets us a result.
(dolist (method local-tags-methods)
(if tags
(throw 'tags t)
(setq tags
(cond
((eq method 'etags)
(local-tags-etags-list))
((eq method 'imenu)
(local-tags-imenu-list)))))))
tags))
;; Find matches for a tag in current buffer.
(defun local-tags-find (tag &optional overriding-methods)
"Return matches for tag TAG in current buffer.
The list of methods tried to find tags is specified by the
variable `local-tags-methods'. Alternatively, optional argument
`overriding-methods' can be used to speify the list of methods.
Return nil when no matches have been found. Otherwise, return a
cons whose caar denotes the function to call for going to a
matching location and whose cdr is the list of locations."
(interactive)
(let (hits)
(catch 'hits
;; Run methods until one of them gets us a result.
(dolist (method (or overriding-methods local-tags-methods))
(if hits
(throw 'hits t)
(setq hits
(cond
((eq method 'etags)
(local-tags-etags-find tag))
((eq method 'imenu)
(local-tags-imenu-find tag))
((eq method 'syntax)
(local-tags-regexp-find tag t))
((eq method 'plain)
(local-tags-regexp-find tag)))))))
hits))
(provide 'local-tags)
- Re: patch: add-log.el: changelog find file under point,
martin rudalics <=
- Unbearably slow editing in .h files (was: patch: add-log.el: changelog find file under point), Stefan Monnier, 2008/02/18
- Re: Unbearably slow editing in .h files, Stefan Monnier, 2008/02/23
- Re: Unbearably slow editing in .h files, Alan Mackenzie, 2008/02/24
- Re: Unbearably slow editing in .h files, Jason Rumney, 2008/02/24
- Re: Unbearably slow editing in .h files, Eli Zaretskii, 2008/02/24
- Re: Unbearably slow editing in .h files, Eli Zaretskii, 2008/02/24