Re: VC top of the tree diff and log

[Dan Nicolaescu]

Dan Nicolaescu <address@hidden> writes:

  > Stefan Monnier <address@hidden> writes:
  > 
  >   > > Key bindings:
  >   > > for log we could have C-x v L  (should be intuitive given that
  >   > > vc-print-log uses C-x v l)
  >   > 
  >   > It might be a good idea.
  >   > 
  >   > > not sure what would be a good one for diff
  >   > 
  >   > I don't understand: why not just use the capitalized = sign?
  > 
  > Sorry, I probably use one of those antique keyboards that don't have
  > such a sign...
  > 
  > See what I currently have.  What do you think?

Here's an updated version that implements both top of the tree log and
diff and adds an option to show short logs.  
As it is now it short logs will be shown when a directory is present in
the fileset.  Adding `file' to `vc-log-short-style' will make C-x v l
show short logs for files too.

vc-git.el was changed to support short logs, and vc-cvs.el to ignore the
extra option (all vc backends need a similar change)

WDYT?

Index: vc-cvs.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/vc-cvs.el,v
retrieving revision 1.165
diff -u -3 -p -r1.165 vc-cvs.el
--- vc-cvs.el   7 Jul 2009 15:06:03 -0000       1.165
+++ vc-cvs.el   30 Jul 2009 06:57:41 -0000
@@ -492,7 +492,7 @@ Will fail unless you have administrative
 ;;; History functions
 ;;;
 
-(defun vc-cvs-print-log (files &optional buffer)
+(defun vc-cvs-print-log (files &optional buffer shortlog)
   "Get change logs associated with FILES."
   ;; It's just the catenation of the individual logs.
   (vc-cvs-command
Index: vc-git.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/vc-git.el,v
retrieving revision 1.85
diff -u -3 -p -r1.85 vc-git.el
--- vc-git.el   28 Jul 2009 08:06:40 -0000      1.85
+++ vc-git.el   30 Jul 2009 06:57:41 -0000
@@ -77,7 +77,7 @@
 ;; - merge-news (file)                    see `merge'
 ;; - steal-lock (file &optional revision)         NOT NEEDED
 ;; HISTORY FUNCTIONS
-;; * print-log (files &optional buffer)                   OK
+;; * print-log (files &optional buffer shortlog)   OK
 ;; - log-view-mode ()                             OK
 ;; - show-log-entry (revision)                    OK
 ;; - comment-history (file)                       ??
@@ -460,7 +460,7 @@ If nil, use the value of `vc-diff-switch
 
 ;;; HISTORY FUNCTIONS
 
-(defun vc-git-print-log (files &optional buffer)
+(defun vc-git-print-log (files &optional buffer shortlog)
   "Get change log associated with FILES."
   (let ((coding-system-for-read git-commits-coding-system)
        ;; Support both the old print-log interface that passes a
@@ -474,43 +474,59 @@ If nil, use the value of `vc-diff-switch
     (let ((inhibit-read-only t))
       (with-current-buffer
           buffer
-       (vc-git-command buffer 'async files
-                       "rev-list" "--pretty" "HEAD" "--")))))
+       (if shortlog
+           (vc-git-command buffer 'async files
+                           "log" "--graph"
+                           "--date=short" "--pretty=format:%h  %ad  %s" 
"--abbrev-commit"
+                           "--")
+         (vc-git-command buffer 'async files
+                         "rev-list" "--graph" "--pretty" "HEAD" "--"))))))
 
 (defvar log-view-message-re)
 (defvar log-view-file-re)
 (defvar log-view-font-lock-keywords)
 (defvar log-view-per-file-logs)
 
+;; Dynamically bound.
+(defvar vc-short-log)
+
 (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
   (require 'add-log) ;; we need the faces add-log
   ;; Don't have file markers, so use impossible regexp.
   (set (make-local-variable 'log-view-file-re) "\\`a\\`")
   (set (make-local-variable 'log-view-per-file-logs) nil)
   (set (make-local-variable 'log-view-message-re)
-       "^commit *\\([0-9a-z]+\\)")
+       (if vc-short-log
+        "^[*/\\| ]+ \\([0-9a-z]+\\)  \\([-a-z0-9]+\\)  \\(.*\\)"
+        "^[ */\\|]+commit *\\([0-9a-z]+\\)"))
   (set (make-local-variable 'log-view-font-lock-keywords)
-       (append
-        `((,log-view-message-re  (1 'change-log-acknowledgement)))
-        ;; Handle the case:
-        ;; user: address@hidden
-        '(("^Author:[ \t]+\\(address@hidden)"
-           (1 'change-log-email))
-          ;; Handle the case:
-          ;; user: FirstName LastName <address@hidden>
-          ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\(address@hidden)[>)]"
-           (1 'change-log-name)
-           (2 'change-log-email))
-          ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ 
\t]+\\(address@hidden)"
-           (1 'change-log-name))
-          ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ 
\t]+\\([^<(]+?\\)[ \t]*[(<]\\(address@hidden)[>)]"
-           (1 'change-log-name)
-           (2 'change-log-email))
-          ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
-           (1 'change-log-acknowledgement)
-           (2 'change-log-acknowledgement))
-          ("^Date:   \\(.+\\)" (1 'change-log-date))
-          ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
+       (if vc-short-log
+          (append
+           `((,log-view-message-re
+              (1 'change-log-acknowledgement)
+              (2 'change-log-date))))
+        (append
+         `((,log-view-message-re  (1 'change-log-acknowledgement)))
+         ;; Handle the case:
+         ;; user: address@hidden
+         '((" Author:[ \t]+\\(address@hidden)"
+            (1 'change-log-email))
+           ;; Handle the case:
+           ;; user: FirstName LastName <address@hidden>
+           (" Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\(address@hidden)[>)]"
+            (1 'change-log-name)
+            (2 'change-log-email))
+           ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ 
\t]+\\(address@hidden)"
+            (1 'change-log-name))
+           ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ 
\t]+\\([^<(]+?\\)[ \t]*[(<]\\(address@hidden)[>)]"
+            (1 'change-log-name)
+            (2 'change-log-email))
+           (" Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
+            (1 'change-log-acknowledgement)
+            (2 'change-log-acknowledgement))
+           (" Date:   \\(.+\\)" (1 'change-log-date))
+           (" summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
+
 
 (defun vc-git-show-log-entry (revision)
   "Move to the log entry for REVISION.
Index: vc-hooks.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/vc-hooks.el,v
retrieving revision 1.279
diff -u -3 -p -r1.279 vc-hooks.el
--- vc-hooks.el 26 Jun 2009 23:54:00 -0000      1.279
+++ vc-hooks.el 30 Jul 2009 06:57:41 -0000
@@ -934,6 +934,7 @@ current, and kill the buffer that visits
     (define-key map "h" 'vc-insert-headers)
     (define-key map "i" 'vc-register)
     (define-key map "l" 'vc-print-log)
+    (define-key map "L" 'vc-print-root-log)
     (define-key map "m" 'vc-merge)
     (define-key map "r" 'vc-retrieve-tag)
     (define-key map "s" 'vc-create-tag)
@@ -941,6 +942,7 @@ current, and kill the buffer that visits
     (define-key map "v" 'vc-next-action)
     (define-key map "+" 'vc-update)
     (define-key map "=" 'vc-diff)
+    (define-key map "D" 'vc-root-diff)
     (define-key map "~" 'vc-revision-other-window)
     map))
 (fset 'vc-prefix-map vc-prefix-map)
@@ -969,12 +971,18 @@ current, and kill the buffer that visits
     (define-key map [vc-diff]
       '(menu-item "Compare with Base Version" vc-diff
                  :help "Compare file set with the base version"))
+    (define-key map [vc-root-diff]
+      '(menu-item "Compare Tree with Base Version" vc-root-diff
+                 :help "Compare current tree with the base version"))
     (define-key map [vc-update-change-log]
       '(menu-item "Update ChangeLog" vc-update-change-log
                  :help "Find change log file and add entries from recent 
version control logs"))
     (define-key map [vc-print-log]
       '(menu-item "Show History" vc-print-log
                  :help "List the change log of the current file set in a 
window"))
+    (define-key map [vc-print-root-log]
+      '(menu-item "Show Top of the Tree History " vc-print-root-log
+                 :help "List the change log for the current tree in a window"))
     (define-key map [separator2] '("----"))
     (define-key map [vc-insert-header]
       '(menu-item "Insert Header" vc-insert-headers
Index: vc.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/vc.el,v
retrieving revision 1.722
diff -u -3 -p -r1.722 vc.el
--- vc.el       23 Jul 2009 05:41:28 -0000      1.722
+++ vc.el       30 Jul 2009 06:57:41 -0000
@@ -350,11 +350,12 @@
 ;;
 ;; HISTORY FUNCTIONS
 ;;
-;; * print-log (files &optional buffer)
+;; * print-log (files &optional buffer shortlog)
 ;;
 ;;   Insert the revision log for FILES into BUFFER, or the *vc* buffer
 ;;   if BUFFER is nil.  (Note: older versions of this function expected
 ;;   only a single file argument.)
+;;   If SHORTLOG is true insert a short version of the log.
 ;;
 ;; - log-view-mode ()
 ;;
@@ -465,6 +466,9 @@
 ;;   `revert' operations itself, without calling the backend system.  The
 ;;   default implementation always returns nil.
 ;;
+;; - root (file)
+;;   Return the root of the VC controlled hierarchy for file.
+;;
 ;; - repository-hostname (dirname)
 ;;
 ;;   Return the hostname that the backend will have to contact
@@ -1594,6 +1598,33 @@ saving the buffer."
     (vc-diff-internal t (vc-deduce-fileset) nil nil (interactive-p))))
 
 ;;;###autoload
+(defun vc-root-diff (historic &optional not-urgent)
+  "Display diffs between file revisions.
+Normally this compares the currently selected fileset with their
+working revisions.  With a prefix argument HISTORIC, it reads two revision
+designators specifying which revisions to compare.
+
+The optional argument NOT-URGENT non-nil means it is ok to say no to
+saving the buffer."
+  (interactive (list current-prefix-arg t))
+  (if historic
+      ;; FIXME: this does not work right, `vc-version-diff' ends up
+      ;; calling `vc-deduce-fileset' to find the files to diff, and
+      ;; that's not what we want here, we want the diff for the VC root dir.
+      (call-interactively 'vc-version-diff)
+    (when buffer-file-name (vc-buffer-sync not-urgent))
+    (let ((backend
+          (cond ((derived-mode-p 'vc-dir-mode)  vc-dir-backend)
+                (vc-mode (vc-backend buffer-file-name))))
+         rootdir working-revision)
+      (unless backend
+       (error "Buffer is not version controlled"))
+      (setq rootdir (vc-call-backend backend 'root default-directory))
+      (setq working-revision (vc-working-revision rootdir))
+      (vc-diff-internal
+       t (list backend (list rootdir) working-revision) nil nil 
(interactive-p)))))
+
+;;;###autoload
 (defun vc-revision-other-window (rev)
   "Visit revision REV of the current file in another window.
 If the current file is named `F', the revision is named `F.~REV~'.
@@ -1817,34 +1848,54 @@ allowed and simply skipped)."
 
 ;; Miscellaneous other entry points
 
+;; FIXME: this should be a defcustom
+;; FIXME: maybe add another choice:
+;; `root-directory' (or somesuch), which would mean show a short log
+;; for the root directory.
+(defvar vc-log-short-style '(directory)
+  "Whether or not to show a short log.
+If it contains `directory' then if the fileset contains a directory show a 
short log.
+If it contains `file' then show short logs for files.
+Not all VC backends support short logs!")
+
 (defun vc-print-log-internal (backend files working-revision)
   ;; Don't switch to the output buffer before running the command,
   ;; so that any buffer-local settings in the vc-controlled
   ;; buffer can be accessed by the command.
-  (vc-call-backend backend 'print-log files "*vc-change-log*")
-  (pop-to-buffer "*vc-change-log*")
-  (vc-exec-after
-   `(let ((inhibit-read-only t))
-      (vc-call-backend ',backend 'log-view-mode)
-      (set (make-local-variable 'log-view-vc-backend) ',backend)
-      (set (make-local-variable 'log-view-vc-fileset) ',files)
-      
-      ;; FIXME: this seems to apply only to RCS/CVS, it doesn't quite
-      ;; belong here in the generic code.
-      (goto-char (point-max))
-      (forward-line -1)
-      (while (looking-at "=*\n")
-       (delete-char (- (match-end 0) (match-beginning 0)))
-       (forward-line -1))
-      (goto-char (point-min))
-      (when (looking-at "[\b\t\n\v\f\r ]+")
-       (delete-char (- (match-end 0) (match-beginning 0))))
-
-      (shrink-window-if-larger-than-buffer)
-      ;; move point to the log entry for the working revision
-      (vc-call-backend ',backend 'show-log-entry ',working-revision)
-      (setq vc-sentinel-movepoint (point))
-      (set-buffer-modified-p nil))))
+  (let ((dir-present nil)
+       (vc-short-log nil))
+    (dolist (file files)
+      (when (file-directory-p file)
+       (setq dir-present t)))
+    (setq vc-short-log
+         (not (null (if dir-present
+                        (memq 'directory vc-log-short-style)
+                      (memq 'file vc-log-short-style)))))
+    (vc-call-backend backend 'print-log files "*vc-change-log*" vc-short-log)
+    (pop-to-buffer "*vc-change-log*")
+    (vc-exec-after
+     `(let ((inhibit-read-only t)
+           (vc-short-log ,vc-short-log))
+       (vc-call-backend ',backend 'log-view-mode)
+       (set (make-local-variable 'log-view-vc-backend) ',backend)
+       (set (make-local-variable 'log-view-vc-fileset) ',files)
+
+       ;; FIXME: this seems to apply only to RCS/CVS, it doesn't quite
+       ;; belong here in the generic code.
+       (goto-char (point-max))
+       (forward-line -1)
+       (while (looking-at "=*\n")
+         (delete-char (- (match-end 0) (match-beginning 0)))
+         (forward-line -1))
+       (goto-char (point-min))
+       (when (looking-at "[\b\t\n\v\f\r ]+")
+         (delete-char (- (match-end 0) (match-beginning 0))))
+
+       (shrink-window-if-larger-than-buffer)
+       ;; move point to the log entry for the working revision
+       (vc-call-backend ',backend 'show-log-entry ',working-revision)
+       (setq vc-sentinel-movepoint (point))
+       (set-buffer-modified-p nil)))))
 
 ;;;###autoload
 (defun vc-print-log (&optional working-revision)
@@ -1858,6 +1909,20 @@ If WORKING-REVISION is non-nil, leave th
     (vc-print-log-internal backend files working-revision)))
 
 ;;;###autoload
+(defun vc-print-root-log ()
+  "List the change log of for the current VC controlled tree in a window."
+  (interactive)
+  (let ((backend
+        (cond ((derived-mode-p 'vc-dir-mode)  vc-dir-backend)
+              (vc-mode (vc-backend buffer-file-name))))
+       rootdir working-revision)
+    (unless backend
+      (error "Buffer is not version controlled"))
+    (setq rootdir (vc-call-backend backend 'root default-directory))
+    (setq working-revision (vc-working-revision rootdir))
+    (vc-print-log-internal backend (list rootdir) working-revision)))
+
+;;;###autoload
 (defun vc-revert ()
   "Revert working copies of the selected fileset to their repository contents.
 This asks for confirmation if the buffer contents are not identical