[Emacs-diffs] /srv/bzr/emacs/trunk r103259: Bind RET in Log View mode to a command that toggles a more detailed display.

[Chong Yidong]

------------------------------------------------------------
revno: 103259
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sun 2011-02-13 15:04:33 -0500
message:
  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.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/vc/log-view.el
  lisp/vc/vc-bzr.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2011-02-13 12:57:41 +0000
+++ b/etc/NEWS  2011-02-13 20:04:33 +0000
@@ -608,6 +608,16 @@
 
 **** 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
 
 ---

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-02-13 13:44:06 +0000
+++ b/lisp/ChangeLog    2011-02-13 20:04:33 +0000
@@ -1,3 +1,22 @@
+2011-02-13  Chong Yidong  <address@hidden>
+
+       * 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  <address@hidden>
 
        * net/imap.el: Remove file.  All the functionality is in nnimap.el.

=== modified file 'lisp/vc/log-view.el'
--- a/lisp/vc/log-view.el       2011-02-13 03:07:53 +0000
+++ b/lisp/vc/log-view.el       2011-02-13 20:04:33 +0000
@@ -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 @@
        (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 @@
 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 @@
          (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)

=== modified file 'lisp/vc/vc-bzr.el'
--- a/lisp/vc/vc-bzr.el 2011-01-29 21:19:21 +0000
+++ b/lisp/vc/vc-bzr.el 2011-02-13 20:04:33 +0000
@@ -590,6 +590,7 @@
 (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 @@
        (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 @@
                (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))))