Re: VC command for showing outgoing changes

[Dan Nicolaescu <dann@ics.uci.edu>]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

  > Your new patch looks closer, thanks.  But we also still need to factor
  > out the commonality between vc-incoming-outgoing-internal and
  > vc-print-log-internal.

Here's a new version that does that.  OK?

Index: vc.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/vc.el,v
retrieving revision 1.746
diff -u -3 -p -u -p -r1.746 vc.el
--- vc.el	7 Dec 2009 09:02:16 -0000	1.746
+++ vc.el	1 Jan 2010 18:51:19 -0000
@@ -344,6 +344,16 @@
 ;;   revision.  At this point START-REVISION is only required to work
 ;;   in conjunction with LIMIT = 1.
 ;;
+;; * log-outgoing (backend remote-location)
+;;
+;;   Insert in BUFFER the revision log for the changes that will be
+;;   sent when performing a push operation to REMOTE-LOCATION.
+;;
+;; * log-incoming (backend remote-location)
+;;
+;;   Insert in BUFFER the revision log for the changes that will be
+;;   received when performing a pull operation from REMOTE-LOCATION.
+;;
 ;; - log-view-mode ()
 ;;
 ;;   Mode to use for the output of print-log.  This defaults to
@@ -1865,13 +1875,34 @@ Not all VC backends support short logs!"
 (defvar log-view-vc-backend)
 (defvar log-view-vc-fileset)
 
+(defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return)
+  (when (and limit (not (eq 'limit-unsupported pl-return))
+	     (not is-start-revision))
+    (goto-char (point-max))
+    (lexical-let ((working-revision working-revision))
+      (widget-create 'push-button
+		     :notify (lambda (&rest ignore)
+			       (vc-print-log-internal
+				log-view-vc-backend log-view-vc-fileset
+				working-revision nil (* 2 limit)))
+		     :help-echo "Show the log again, and double the number of log entries shown"
+		     "Show 2X entries")
+      (widget-insert "    ")
+      (widget-create 'push-button
+		     :notify (lambda (&rest ignore)
+			       (vc-print-log-internal
+				log-view-vc-backend log-view-vc-fileset
+				working-revision nil nil))
+		     :help-echo "Show the log again, showing all entries"
+		     "Show unlimited entries"))
+    (widget-setup)))
+
 (defun vc-print-log-internal (backend files working-revision
-                                      &optional is-start-revision limit)
-  ;; 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.
+				      &optional is-start-revision limit)
   (let ((dir-present nil)
 	(vc-short-log nil)
+	(buffer-name "*vc-change-log*")
+	type
 	pl-return)
     (dolist (file files)
       (when (file-directory-p file)
@@ -1880,44 +1911,58 @@ Not all VC backends support short logs!"
 	  (not (null (if dir-present
 			 (memq 'directory vc-log-short-style)
 		       (memq 'file vc-log-short-style)))))
-
-    (setq pl-return (vc-call-backend
-		     backend 'print-log files "*vc-change-log*"
-		     vc-short-log (when is-start-revision working-revision) limit))
-    (pop-to-buffer "*vc-change-log*")
+    (setq type (if vc-short-log 'short 'long))
+    (lexical-let
+	((working-revision working-revision)
+	 (limit limit)
+	 (shortlog vc-short-log)
+	 (is-start-revision is-start-revision))
+      (vc-log-internal-common
+       backend buffer-name files type
+       (lambda (bk buf type-arg files-arg)
+	 (vc-call-backend bk 'print-log files-arg buf
+			  shortlog (when is-start-revision working-revision) limit))
+       (lambda (bk files-arg ret)
+	 (vc-print-log-setup-buttons working-revision
+				     is-start-revision limit ret))
+       (lambda (bk)
+	 (vc-call-backend bk 'show-log-entry working-revision))))))
+
+(defun vc-log-internal-common (backend
+			       buffer-name
+			       files
+			       type
+			       backend-func
+			       setup-buttons-func
+			       goto-location-func)
+  (let (retval)
+    (with-current-buffer (get-buffer-create buffer-name)
+      (set (make-local-variable 'log-view-type) type))
+    (setq retval (funcall backend-func backend buffer-name type files))
+    (pop-to-buffer buffer-name)
     (let ((inhibit-read-only t))
-      ;; log-view-mode used to be called with inhibit-read-only bound
-      ;; to t, so let's keep doing it, just in case.
-      (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)
-
+      (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))
     (vc-exec-after
      `(let ((inhibit-read-only t))
-	(when (and ,limit (not ,(eq 'limit-unsupported pl-return))
-		   (not ,is-start-revision))
-	  (goto-char (point-max))
-	  (widget-create 'push-button
-			 :notify (lambda (&rest ignore)
-				   (vc-print-log-internal
-				    ',backend ',files ',working-revision nil (* 2 ,limit)))
-			 :help-echo "Show the log again, and double the number of log entries shown"
-			 "Show 2X entries")
-	  (widget-insert "    ")
-	  (widget-create 'push-button
-			 :notify (lambda (&rest ignore)
-				   (vc-print-log-internal
-				    ',backend ',files ',working-revision nil nil))
-			 :help-echo "Show the log again, showing all entries"
-			 "Show unlimited entries")
-	  (widget-setup))
-
+	(funcall ',setup-buttons-func ',backend ',files ',retval)
 	(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)
+	(funcall ',goto-location-func ',backend)
 	(setq vc-sentinel-movepoint (point))
 	(set-buffer-modified-p nil)))))
 
+(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type)
+  (vc-log-internal-common
+   backend buffer-name nil type
+   (lexical-let
+       ((remote-location remote-location))
+     (lambda (bk buf type-arg files)
+       (vc-call-backend bk type-arg buf remote-location)))
+   (lambda (bk files-arg ret))
+   (lambda (bk)
+     (goto-char (point-min)))))
+
 ;;;###autoload
 (defun vc-print-log (&optional working-revision limit)
   "List the change log of the current fileset in a window.
@@ -1938,10 +1983,10 @@ If WORKING-REVISION is non-nil, leave th
     (t
      (list nil (when (> vc-log-show-limit 0) vc-log-show-limit)))))
   (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: Why t? --Stef
-	 (backend (car vc-fileset))
+	 (backend5 (car vc-fileset))
 	 (files (cadr vc-fileset))
 	 (working-revision (or working-revision (vc-working-revision (car files)))))
-    (vc-print-log-internal backend files working-revision nil limit)))
+    (vc-print-log-internal backend5 files working-revision nil limit)))
 
 ;;;###autoload
 (defun vc-print-root-log (&optional limit)
@@ -1970,6 +2015,32 @@ If WORKING-REVISION is non-nil, leave th
     (vc-print-log-internal backend (list rootdir) working-revision nil limit)))
 
 ;;;###autoload
+(defun vc-log-incoming (&optional remote-location)
+  "Show a log of changes that will be received with a pull operation from REMOTE-LOCATION."
+  (interactive "sRemote location (empty for default): ")
+  (let ((backend
+	 (cond ((derived-mode-p 'vc-dir-mode)  vc-dir-backend)
+	       ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory))
+	       (vc-mode (vc-backend buffer-file-name))))
+	rootdir working-revision)
+    (unless backend
+      (error "Buffer is not version controlled"))
+    (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*" 'log-incoming)))
+
+;;;###autoload
+(defun vc-log-outgoing (&optional remote-location)
+  "Show a log of changes that will be sent with a push operation to REMOTE-LOCATION."
+  (interactive "sRemote location (empty for default): ")
+  (let ((backend
+	 (cond ((derived-mode-p 'vc-dir-mode)  vc-dir-backend)
+	       ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory))
+	       (vc-mode (vc-backend buffer-file-name))))
+	rootdir working-revision)
+    (unless backend
+      (error "Buffer is not version controlled"))
+    (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*" 'log-outgoing)))
+
+;;;###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