From: martin rudalics <rudalics@gmx.at>
To: emacs-devel <emacs-devel@gnu.org>
Subject: Finding the source of Change Log entries
Date: Sat, 12 Jul 2008 11:32:15 +0200 [thread overview]
Message-ID: <48787A1F.1080105@gmx.at> (raw)
[-- Attachment #1: Type: text/plain, Size: 128 bytes --]
Months ago I wrote a couple of functions to find the source code
corresponding to Change Log entries. Anyone still interested?
[-- Attachment #2: add-log.patch --]
[-- Type: text/plain, Size: 9274 bytes --]
*** add-log.el.~1.212.~ 2008-06-24 06:04:48.000000000 +0200
--- add-log.el 2008-07-12 10:14:41.796875000 +0200
***************
*** 298,307 ****
;; 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
--- 298,307 ----
;; 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
***************
*** 312,322 ****
;; 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."
--- 312,322 ----
;; 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."
***************
*** 326,336 ****
--- 326,521 ----
(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.")
next reply other threads:[~2008-07-12 9:32 UTC|newest]
Thread overview: 30+ messages / expand[flat|nested] mbox.gz Atom feed top
2008-07-12 9:32 martin rudalics [this message]
2008-07-12 10:00 ` Finding the source of Change Log entries Lennart Borgman (gmail)
2008-07-12 10:32 ` martin rudalics
2008-07-12 14:52 ` Chong Yidong
2008-07-13 8:33 ` martin rudalics
2008-07-13 22:14 ` Juri Linkov
2008-07-14 8:40 ` martin rudalics
2008-07-14 21:57 ` Juri Linkov
2008-07-16 17:20 ` martin rudalics
2008-08-07 10:10 ` martin rudalics
2008-07-14 13:50 ` Ted Zlatanov
2008-07-14 21:54 ` Juri Linkov
2008-07-15 6:23 ` Andrew W. Nosenko
2008-07-15 9:48 ` Juri Linkov
2008-07-15 14:56 ` Ted Zlatanov
2008-07-15 20:35 ` Juri Linkov
2008-07-16 17:20 ` martin rudalics
2008-08-05 18:43 ` Ted Zlatanov
2008-08-25 15:43 ` Juri Linkov
2008-08-27 18:37 ` Ted Zlatanov
2008-08-27 20:43 ` Stefan Monnier
2008-08-27 20:57 ` Ted Zlatanov
2008-08-28 2:03 ` Stefan Monnier
2008-09-10 23:59 ` Juri Linkov
2008-09-14 11:27 ` martin rudalics
2008-07-14 14:00 ` Dan Nicolaescu
2008-07-16 17:18 ` martin rudalics
2008-07-27 21:47 ` Dan Nicolaescu
2008-07-28 18:50 ` martin rudalics
2008-07-28 21:53 ` Stefan Monnier
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=48787A1F.1080105@gmx.at \
--to=rudalics@gmx.at \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.