From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: martin rudalics Newsgroups: gmane.emacs.devel Subject: Finding the source of Change Log entries Date: Sat, 12 Jul 2008 11:32:15 +0200 Message-ID: <48787A1F.1080105@gmx.at> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------080602030303040703090109" X-Trace: ger.gmane.org 1215855242 23253 80.91.229.12 (12 Jul 2008 09:34:02 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 12 Jul 2008 09:34:02 +0000 (UTC) To: emacs-devel Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Jul 12 11:34:49 2008 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1KHbVA-0001vb-Fa for ged-emacs-devel@m.gmane.org; Sat, 12 Jul 2008 11:34:48 +0200 Original-Received: from localhost ([127.0.0.1]:50232 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1KHbUI-0005sG-8Q for ged-emacs-devel@m.gmane.org; Sat, 12 Jul 2008 05:33:54 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1KHbUB-0005rv-7l for emacs-devel@gnu.org; Sat, 12 Jul 2008 05:33:47 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1KHbU9-0005rO-8i for emacs-devel@gnu.org; Sat, 12 Jul 2008 05:33:45 -0400 Original-Received: from [199.232.76.173] (port=58726 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1KHbU8-0005rI-Ms for emacs-devel@gnu.org; Sat, 12 Jul 2008 05:33:44 -0400 Original-Received: from mail.gmx.net ([213.165.64.20]:55649) by monty-python.gnu.org with smtp (Exim 4.60) (envelope-from ) id 1KHbU8-0000gU-6O for emacs-devel@gnu.org; Sat, 12 Jul 2008 05:33:44 -0400 Original-Received: (qmail invoked by alias); 12 Jul 2008 09:33:40 -0000 Original-Received: from 62-47-45-136.adsl.highway.telekom.at (EHLO [62.47.45.136]) [62.47.45.136] by mail.gmx.net (mp039) with SMTP; 12 Jul 2008 11:33:40 +0200 X-Authenticated: #14592706 X-Provags-ID: V01U2FsdGVkX1/DYDEl4+vDKOtW5Zs4Oq/tyXffnzvdmDKx1A5rat Mr1QYWZu94geef User-Agent: Mozilla Thunderbird 1.0 (Windows/20041206) X-Accept-Language: de-DE, de, en-us, en X-Y-GMX-Trusted: 0 X-FuHaFi: 0.89,0.48 X-detected-kernel: by monty-python.gnu.org: Linux 2.6 (newer, 3) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:100606 Archived-At: This is a multi-part message in MIME format. --------------080602030303040703090109 Content-Type: text/plain; charset=ISO-8859-15; format=flowed Content-Transfer-Encoding: 7bit Months ago I wrote a couple of functions to find the source code corresponding to Change Log entries. Anyone still interested? --------------080602030303040703090109 Content-Type: text/plain; name="add-log.patch" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="add-log.patch" *** 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.") --------------080602030303040703090109--