Bind RET in Log View mode to a command that toggles a more detailed display.

* lisp/vc/log-view.el: New command log-view-toggle-entry-display for
toggling log entries between concise and detailed forms.
(log-view-toggle-entry-display): New command.
(log-view-mode-map): Bind RET to it.
(log-view-expanded-log-entry-function): New variable.
(log-view-current-entry, log-view-inside-comment-p)
(log-view-current-tag): New functions.
(log-view-toggle-mark-entry): Use log-view-current-entry and
log-view-end-of-defun instead of searching directly with
log-view-message-re.
(log-view-end-of-defun): Likewise.  Add optional ARG for
compatibility with end-of-defun.
(log-view-end-of-defun): Ignore comments and VC buttons.

* lisp/vc/vc-bzr.el (vc-bzr-expanded-log-entry): New function.
(vc-bzr-log-view-mode): Use log-view-expanded-log-entry-function.

4 files changed, 165 insertions, 74 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 1a030d5972a..c8bfffcd789 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -608,6 +608,16 @@ the user for specifics, e.g. a merge source.
 
 **** Currently supported by Bzr, Git, and Mercurial.
 
+*** Log entries in some Log View buffers can be toggled to display a
+longer description by typing RET (log-view-toggle-entry-display).
+In the Log View buffers made by `C-x v L' (vc-print-root-log), you can
+use this to display the full log entry for the revision at point.
+
+**** Currently supported by Bzr.
+
+**** Packages using Log View mode can enable this functionality by
+binding `log-view-expanded-log-entry-function' to a suitable function.
+
 ** Miscellaneous
 
 ---
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f7361b1c108..bf347d2a70f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,22 @@
+2011-02-13  Chong Yidong  <cyd@stupidchicken.com>
+
+        * vc/log-view.el: New command log-view-toggle-entry-display for
+        toggling log entries between concise and detailed forms.
+        (log-view-toggle-entry-display): New command.
+        (log-view-mode-map): Bind RET to it.
+        (log-view-expanded-log-entry-function): New variable.
+        (log-view-current-entry, log-view-inside-comment-p)
+        (log-view-current-tag): New functions.
+        (log-view-toggle-mark-entry): Use log-view-current-entry and
+        log-view-end-of-defun instead of searching directly with
+        log-view-message-re.
+        (log-view-end-of-defun): Likewise.  Add optional ARG for
+        compatibility with end-of-defun.
+        (log-view-end-of-defun): Ignore comments and VC buttons.
+
+        * vc/vc-bzr.el (vc-bzr-expanded-log-entry): New function.
+        (vc-bzr-log-view-mode): Use log-view-expanded-log-entry-function.
+
 2011-02-13  Teodor Zlatanov  <tzz@lifelogs.com>
 
         * net/imap.el: Remove file.  All the functionality is in nnimap.el.
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index f71c928c693..3753904324b 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -130,6 +130,7 @@
     ("z" . kill-this-buffer)
     ("q" . quit-window)
     ("g" . revert-buffer)
+    ("\C-m" . log-view-toggle-entry-display)
 
     ("m" . log-view-toggle-mark-entry)
     ("e" . log-view-modify-change-comment)
@@ -180,6 +181,12 @@
 (defvar log-view-mode-hook nil
   "Hook run at the end of `log-view-mode'.")
 
+(defvar log-view-expanded-log-entry-function nil
+  "Function returning the detailed description of a Log View entry.
+It is called by the command `log-view-toggle-entry-display' with
+one arg, the revision tag (a string), and should return a string.
+If it is nil, `log-view-toggle-entry-display' does nothing.")
+
 (defface log-view-file
   '((((class color) (background light))
      (:background "grey70" :weight bold))
@@ -299,15 +306,36 @@ The match group number 1 should match the revision number itself.")
         (when cvsdir (setq dir (expand-file-name cvsdir dir))))
       (expand-file-name file dir))))
 
-(defun log-view-current-tag (&optional where)
-  (save-excursion
-    (when where (goto-char where))
-    (forward-line 1)
-    (let ((pt (point)))
-      (when (re-search-backward log-view-message-re nil t)
-        (let ((rev (match-string-no-properties 1)))
-          (unless (re-search-forward log-view-file-re pt t)
-            rev))))))
+(defun log-view-current-entry (&optional pos move)
+  "Return the position and revision tag of the Log View entry at POS.
+This is a list (BEG TAG), where BEG is a buffer position and TAG
+is a string.  If POS is nil or omitted, it defaults to point.
+If there is no entry at POS, return nil.
+
+If optional arg MOVE is non-nil, move point to BEG if found.
+Otherwise, don't move point."
+  (let ((looping t)
+        result)
+    (save-excursion
+      (when pos (goto-char pos))
+      (forward-line 1)
+      (while looping
+        (setq pos (re-search-backward log-view-message-re nil 'move)
+              looping (and pos (log-view-inside-comment-p (point)))))
+      (when pos
+        (setq result
+              (list pos (match-string-no-properties 1)))))
+    (and move result (goto-char pos))
+    result))
+
+(defun log-view-inside-comment-p (pos)
+  "Return non-nil if POS lies inside an expanded log entry."
+  (eq (get-text-property pos 'log-view-comment) t))
+
+(defun log-view-current-tag (&optional pos)
+  "Return the revision tag (a string) of the Log View entry at POS.
+if POS is omitted or nil, it defaults to point."
+  (cadr (log-view-current-entry pos)))
 
 (defun log-view-toggle-mark-entry ()
   "Toggle the marked state for the log entry at point.
@@ -317,29 +345,24 @@ entries are denoted by changing their background color.
 log entries."
   (interactive)
   (save-excursion
-    (forward-line 1)
-    (let ((pt (point)))
-      (when (re-search-backward log-view-message-re nil t)
-        (let ((beg (match-beginning 0))
-              end ov ovlist found tag)
-          (unless (re-search-forward log-view-file-re pt t)
-            ;; Look to see if the current entry is marked.
-            (setq found (get-char-property (point) 'log-view-self))
-            (if found
-                (delete-overlay found)
-              ;; Create an overlay that covers this entry and change
-              ;; its color.
-              (setq tag (log-view-current-tag (point)))
-              (forward-line 1)
-              (setq end
-                    (if (re-search-forward log-view-message-re nil t)
-                        (match-beginning 0)
-                      (point-max)))
-              (setq ov (make-overlay beg end))
-              (overlay-put ov 'face 'log-view-file)
-              ;; This is used to check if the overlay is present.
-              (overlay-put ov 'log-view-self ov)
-              (overlay-put ov 'log-view-marked tag))))))))
+    (let* ((entry (log-view-current-entry nil t))
+           (beg (car entry))
+           found)
+      (when entry
+        ;; Look to see if the current entry is marked.
+        (setq found (get-char-property beg 'log-view-self))
+        (if found
+            (delete-overlay found)
+          ;; Create an overlay covering this entry and change its color.
+          (let* ((end (if (get-text-property beg 'log-view-entry-expanded)
+                          (next-single-property-change beg 'log-view-comment)
+                        (log-view-end-of-defun)
+                        (point)))
+                 (ov (make-overlay beg end)))
+            (overlay-put ov 'face 'log-view-file)
+            ;; This is used to check if the overlay is present.
+            (overlay-put ov 'log-view-self ov)
+            (overlay-put ov 'log-view-marked (nth 1 entry))))))))
 
 (defun log-view-get-marked ()
   "Return the list of tags for the marked log entries."
@@ -352,50 +375,74 @@ log entries."
           (setq pos (overlay-end ov))))
       marked-list)))
 
-(defun log-view-beginning-of-defun ()
-  ;; This assumes that a log entry starts with a line matching
-  ;; `log-view-message-re'.  Modes that derive from `log-view-mode'
-  ;; for which this assumption is not valid will have to provide
-  ;; another implementation of this function.  `log-view-msg-prev'
-  ;; does a similar job to this function, we can't use it here
-  ;; directly because it prints messages that are not appropriate in
-  ;; this context and it does not move to the beginning of the buffer
-  ;; when the point is before the first log entry.
-
-  ;; `log-view-beginning-of-defun' and `log-view-end-of-defun' have
-  ;; been checked to work with logs produced by RCS, CVS, git,
-  ;; mercurial and subversion.
-
-  (re-search-backward log-view-message-re nil 'move))
+(defun log-view-toggle-entry-display ()
+  (interactive)
+  ;; Don't do anything unless `log-view-expanded-log-entry-function'
+  ;; is defined in this mode.
+  (when (functionp log-view-expanded-log-entry-function)
+    (let* ((opoint (point))
+           (entry (log-view-current-entry nil t))
+           (beg (car entry))
+           (buffer-read-only nil))
+      (when entry
+        (if (get-text-property beg 'log-view-entry-expanded)
+            ;; If the entry is expanded, collapse it.
+            (let ((pos (next-single-property-change beg 'log-view-comment)))
+              (unless (and pos (log-view-inside-comment-p pos))
+                (error "Broken markup in `log-view-toggle-entry-display'"))
+              (delete-region pos
+                             (next-single-property-change pos 'log-view-comment))
+              (put-text-property beg (1+ beg) 'log-view-entry-expanded nil)
+              (if (< opoint pos)
+                  (goto-char opoint)))
+          ;; Otherwise, expand the entry.
+          (let ((long-entry (funcall log-view-expanded-log-entry-function
+                                     (nth 1 entry))))
+            (when long-entry
+              (put-text-property beg (1+ beg) 'log-view-entry-expanded t)
+              (log-view-end-of-defun)
+              (setq beg (point))
+              (insert long-entry "\n")
+              (add-text-properties
+               beg (point)
+               '(font-lock-face font-lock-comment-face log-view-comment t))
+              (goto-char opoint))))))))
+
+(defun log-view-beginning-of-defun (&optional arg)
+  "Move backward to the beginning of a Log View entry.
+With ARG, do it that many times.  Negative ARG means move forward
+to the beginning of the ARGth following entry.
+
+This is Log View mode's default `beginning-of-defun-function'.
+It assumes that a log entry starts with a line matching
+`log-view-message-re'."
+  (if (or (null arg) (zerop arg))
+      (setq arg 1))
+  (if (< arg 0)
+      (dotimes (n (- arg))
+        (log-view-end-of-defun))
+    (catch 'beginning-of-buffer
+      (dotimes (n arg)
+        (or (log-view-current-entry nil t)
+            (throw 'beginning-of-buffer nil)))
+      (point))))
 
 (defun log-view-end-of-defun ()
-  ;; The idea in this function is to search for the beginning of the
-  ;; next log entry using `log-view-message-re' and then go back one
-  ;; line when finding it.  Modes that derive from `log-view-mode' for
-  ;; which this assumption is not valid will have to provide another
-  ;; implementation of this function.
-
-  ;; Look back and if there is no entry there it means we are before
-  ;; the first log entry, so go forward until finding one.
-  (unless (save-excursion (re-search-backward log-view-message-re nil t))
-    (re-search-forward log-view-message-re nil t))
-
-  ;; In case we are at the end of log entry going forward a line will
-  ;; make us find the next entry when searching. If we are inside of
-  ;; an entry going forward a line will still keep the point inside
-  ;; the same entry.
-  (forward-line 1)
-
-  ;; In case we are at the beginning of an entry, move past it.
-  (when (looking-at log-view-message-re)
-    (goto-char (match-end 0))
-    (forward-line 1))
-
-  ;; Search for the start of the next log entry.  Go to the end of the
-  ;; buffer if we could not find a next entry.
-  (when (re-search-forward log-view-message-re nil 'move)
-    (goto-char (match-beginning 0))
-    (forward-line -1)))
+  "Move forward to the next Log View entry."
+  (let ((looping t))
+    (if (looking-at log-view-message-re)
+        (goto-char (match-end 0)))
+    (while looping
+      (cond
+       ((re-search-forward log-view-message-re nil 'move)
+        (unless (log-view-inside-comment-p (point))
+          (setq looping nil)
+          (goto-char (match-beginning 0))))
+       ;; Don't advance past the end buttons inserted by
+       ;; `vc-print-log-setup-buttons'.
+       ((looking-back "Show 2X entries    Show unlimited entries")
+        (setq looping nil)
+        (forward-line -1))))))
 
 (defvar cvs-minor-current-files)
 (defvar cvs-branch-prefix)
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 9f86a28a575..09a622e8fed 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -590,6 +590,7 @@ REV non-nil gets an error."
 (defvar log-view-font-lock-keywords)
 (defvar log-view-current-tag-function)
 (defvar log-view-per-file-logs)
+(defvar log-view-expanded-log-entry-function)
 
 (define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View"
   (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack.
@@ -600,6 +601,10 @@ REV non-nil gets an error."
        (if (eq vc-log-view-type 'short)
            "^ *\\([0-9.]+\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?"
          "^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)"))
+  ;; Allow expanding short log entries
+  (when (eq vc-log-view-type 'short)
+    (set (make-local-variable 'log-view-expanded-log-entry-function)
+         'vc-bzr-expanded-log-entry))
   (set (make-local-variable 'log-view-font-lock-keywords)
        ;; log-view-font-lock-keywords is careful to use the buffer-local
        ;; value of log-view-message-re only since Emacs-23.
@@ -637,6 +642,16 @@ REV non-nil gets an error."
                 (list vc-bzr-log-switches)
               vc-bzr-log-switches)))))
 
+(defun vc-bzr-expanded-log-entry (revision)
+  (with-temp-buffer
+    (apply 'vc-bzr-command "log" t nil nil
+           (list (format "-r%s" revision)))
+    (goto-char (point-min))
+    (when (looking-at "^-+\n")
+      ;; Indent the expanded log entry.
+      (indent-region (match-end 0) (point-max) 2)
+      (buffer-substring (match-end 0) (point-max)))))
+
 (defun vc-bzr-log-incoming (buffer remote-location)
   (apply 'vc-bzr-command "missing" buffer 'async nil
          (list "--theirs-only" (unless (string= remote-location "") remote-location))))