(change-log-search-file-name): Use match-string-no-properties.

(change-log-search-tag-name-1, change-log-search-tag-name)
(change-log-goto-source-1, change-log-goto-source): New functions.
(change-log-tag-re, change-log-find-head, change-log-find-tail):
New variables.
(change-log-mode-map): Bind C-c C-c to change-log-goto-source.

3 files changed, 203 insertions, 5 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 00d668b79d9..993975293e9 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -722,6 +722,9 @@ to update it to the new VC.
 *** In Change Log mode, the new command C-c C-f (change-log-find-file)
 finds the file associated with the current log entry.
 
+*** In Change Log mode, the new command C-c C-c (change-log-goto-source)
+goes to the source code associated with a log entry.
+
 *** comint-mode uses `start-file-process' now (see Lisp Changes).
 If `default-directory' is a remote file name, subprocesses are started
 on the corresponding remote system.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index cee88696b69..e7c29b98e7f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2008-07-13  Martin Rudalics  <rudalics@gmx.at>
+
+        * add-log.el (change-log-search-file-name): Use match-string-no-properties.
+        (change-log-search-tag-name-1, change-log-search-tag-name)
+        (change-log-goto-source-1, change-log-goto-source): New functions.
+        (change-log-tag-re, change-log-find-head, change-log-find-tail):
+        New variables.
+        (change-log-mode-map): Bind C-c C-c to change-log-goto-source.
+
 2008-07-13  Jay Belanger  <jay.p.belanger@gmail.com>
 
         * calc-help.el (calc-describe-key): Add angles to special key
diff --git a/lisp/add-log.el b/lisp/add-log.el
index fc8224293ca..19a537fc0da 100644
--- a/lisp/add-log.el
+++ b/lisp/add-log.el
@@ -298,10 +298,10 @@ Note: The search is conducted only within 10%, at the beginning of the file."
         ;; name.
         (progn
           (re-search-forward change-log-file-names-re nil t)
-          (match-string 2))
+          (match-string-no-properties 2))
       (if (looking-at change-log-file-names-re)
           ;; We found a file name.
-          (match-string 2)
+          (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,11 +312,11 @@ Note: The search is conducted only within 10%, at the beginning of the file."
                 ;; file name.
                 (progn
                   (re-search-forward change-log-file-names-re nil t)
-                  (match-string 2))
-              (match-string 4))
+                  (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 2))))))
+          (match-string-no-properties 2))))))
 
 (defun change-log-find-file ()
   "Visit the file for the change under point."
@@ -326,11 +326,197 @@ Note: The search is conducted only within 10%, at the beginning of the file."
         (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-goto-source-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 tag `%s' in file `%s'" tag file)
+            (setq last first)
+            (goto-char first))
+          ;; Return new "tail".
+          (list (selected-window) first last))
+      (message "Source location of tag `%s' not found in file `%s'" tag file)
+      nil)))
+
+(defun change-log-goto-source ()
+  "Go to source location of change log tag near `point'.
+A change log tag is a symbol within a parenthesized,
+comma-separated list."
+  (interactive)
+  (if (and (eq last-command 'change-log-goto-source)
+           change-log-find-tail)
+      (setq change-log-find-tail
+            (condition-case nil
+                (apply 'change-log-goto-source-1
+                       (append change-log-find-head change-log-find-tail))
+              (error
+               (format "Cannot find more matches for tag `%s' in file `%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-goto-source-1 change-log-find-head))
+            (error (format "Cannot find matches for tag `%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-c] 'change-log-goto-source)
     map)
   "Keymap for Change Log major mode.")