changeset 107795:d47e1fb98df3

Add new VC methods: vc-log-incoming and vc-log-outgoing. * vc.el (vc-print-log-setup-buttons): New function split out from vc-print-log-internal. (vc-log-internal-common): New function, a parametrized version of vc-print-log-internal. (vc-print-log-internal): Just call vc-log-internal-common with the right arguments. (vc-incoming-outgoing-internal): (vc-log-incoming, vc-log-outgoing): New functions. (vc-log-view-type): New permanent local variable. * vc-hooks.el (vc-menu-map): Bind vc-log-incoming and vc-log-outgoing. * vc-bzr.el (vc-bzr-log-view-mode): Use vc-log-view-type instead of the dynamic bound vc-short-log. (vc-bzr-log-incoming, vc-bzr-log-outgoing): New functions. * vc-git.el (vc-git-log-outgoing): New function. (vc-git-log-view-mode): Use vc-log-view-type instead of the dynamic bound vc-short-log. * vc-hg.el (vc-hg-log-view-mode): Use vc-log-view-type instead of the dynamic bound vc-short-log. Highlight the tag. (vc-hg-log-incoming, vc-hg-log-outgoing): New functions. (vc-hg-outgoing, vc-hg-incoming, vc-hg-outgoing-mode): (vc-hg-incoming-mode): Remove. (vc-hg-extra-menu-map): Do not bind vc-hg-incoming and vc-hg-outgoing.
author Dan Nicolaescu <dann@ics.uci.edu>
date Tue, 06 Apr 2010 22:56:35 -0700
parents c4daeb1eaaf1
children 58f5110b2519
files etc/NEWS lisp/ChangeLog lisp/vc-bzr.el lisp/vc-git.el lisp/vc-hg.el lisp/vc-hooks.el lisp/vc.el
diffstat 7 files changed, 188 insertions(+), 84 deletions(-) [+]
line wrap: on
line diff
--- a/etc/NEWS	Tue Apr 06 21:14:56 2010 -0700
+++ b/etc/NEWS	Tue Apr 06 22:56:35 2010 -0700
@@ -95,6 +95,8 @@
 
 ** VC and related modes
 
+*** New VC commands: vc-log-incoming and vc-log-outgoing.
+
 *** vc-dir for Bzr supports viewing shelve contents and shelving snapshots.
 
 *** Special markup can be added to log-edit buffers.
--- a/lisp/ChangeLog	Tue Apr 06 21:14:56 2010 -0700
+++ b/lisp/ChangeLog	Tue Apr 06 22:56:35 2010 -0700
@@ -1,3 +1,33 @@
+2010-04-07  Dan Nicolaescu  <dann@ics.uci.edu>
+
+	Add new VC methods: vc-log-incoming and vc-log-outgoing.
+	* vc.el (vc-print-log-setup-buttons): New function split out from
+	vc-print-log-internal.
+	(vc-log-internal-common): New function, a parametrized version of
+	vc-print-log-internal.
+	(vc-print-log-internal): Just call vc-log-internal-common with the
+	right arguments.
+	(vc-incoming-outgoing-internal):
+	(vc-log-incoming, vc-log-outgoing): New functions.
+	(vc-log-view-type): New permanent local variable.
+
+	* vc-hooks.el (vc-menu-map): Bind vc-log-incoming and vc-log-outgoing.
+
+	* vc-bzr.el (vc-bzr-log-view-mode): Use vc-log-view-type instead
+	of the dynamic bound vc-short-log.
+	(vc-bzr-log-incoming, vc-bzr-log-outgoing): New functions.
+
+	* vc-git.el (vc-git-log-outgoing): New function.
+	(vc-git-log-view-mode): Use vc-log-view-type instead
+	of the dynamic bound vc-short-log.
+
+	* vc-hg.el (vc-hg-log-view-mode): Use vc-log-view-type instead
+	of the dynamic bound vc-short-log.  Highlight the tag.
+	(vc-hg-log-incoming, vc-hg-log-outgoing): New functions.
+	(vc-hg-outgoing, vc-hg-incoming, vc-hg-outgoing-mode):
+	(vc-hg-incoming-mode): Remove.
+	(vc-hg-extra-menu-map): Do not bind vc-hg-incoming and vc-hg-outgoing.
+
 2010-04-07  Dan Nicolaescu  <dann@ics.uci.edu>
 
 	Fix default-directory for vc-root-diff.
@@ -6,9 +36,9 @@
 
 2010-04-07  Michael McNamara  <mac@mail.brushroad.com>
 
-        * verilog-mode.el (verilog-forward-sexp, verilog-calc-1): Support
-        "disable fork" and "fork wait" multi word keywords, suggested by
-        Steve Pearlmutter.
+        * progmodes/verilog-mode.el (verilog-forward-sexp):
+	(verilog-calc-1): Support "disable fork" and "fork wait" multi
+	word keywords, suggested by Steve Pearlmutter.
         (verilog-pretty-declarations): Support lineup of declarations in
 	port lists.
         (verilog-skip-backward-comments, verilog-skip-forward-comment-p):
@@ -23,7 +53,7 @@
 
 2010-04-07  Wilson Snyder  <wsnyder@wsnyder.org>
 
-        * verilog-mode.el (verilog-type-keywords): Fix pulldown as missing
+        * progmodes/verilog-mode.el (verilog-type-keywords): Fix pulldown as missing
         keyword.
         (verilog-read-sub-decls-line): Fix comments in AUTO_TEMPLATE
         causing truncation of AUTOWIRE signals.  Reported by Bruce
--- a/lisp/vc-bzr.el	Tue Apr 06 21:14:56 2010 -0700
+++ b/lisp/vc-bzr.el	Tue Apr 06 22:56:35 2010 -0700
@@ -478,7 +478,6 @@
 (defvar log-view-font-lock-keywords)
 (defvar log-view-current-tag-function)
 (defvar log-view-per-file-logs)
-(defvar vc-short-log)
 
 (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.
@@ -486,13 +485,13 @@
   (set (make-local-variable 'log-view-per-file-logs) nil)
   (set (make-local-variable 'log-view-file-re) "\\`a\\`")
   (set (make-local-variable 'log-view-message-re)
-       (if vc-short-log
+       (if (eq vc-log-view-type 'short)
 	   "^ *\\([0-9.]+\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?"
 	 "^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)"))
   (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.
-       (if vc-short-log
+       (if (eq vc-log-view-type 'short)
 	 (append `((,log-view-message-re
 		    (1 'log-view-message-face)
 		    (2 'change-log-name)
@@ -526,6 +525,14 @@
 		(list vc-bzr-log-switches)
 	      vc-bzr-log-switches)))))
 
+(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))))
+
+(defun vc-bzr-log-outgoing (buffer remote-location)
+  (apply 'vc-bzr-command "missing" buffer 'async nil
+	 (list "--mine-only" (unless (string= remote-location "") remote-location))))
+
 (defun vc-bzr-show-log-entry (revision)
   "Find entry for patch name REVISION in bzr change log buffer."
   (goto-char (point-min))
--- a/lisp/vc-git.el	Tue Apr 06 21:14:56 2010 -0700
+++ b/lisp/vc-git.el	Tue Apr 06 22:56:35 2010 -0700
@@ -592,25 +592,32 @@
 		(when start-revision (list start-revision))
 		'("--")))))))
 
+(defun vc-git-log-outgoing (buffer remote-location)
+  (interactive)
+  (vc-git-command
+   buffer 0 nil
+   "log" (if (string= remote-location "")
+	     ;; FIXME: this hardcodes the location, it should compute
+	     ;; it properly.
+	     "origin/master..HEAD"
+	   remote-location)))
+
 (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)
-       (if vc-short-log
+       (if (eq vc-log-view-type 'short)
 	   "^\\(?:[*/\\| ]+ \\)?\\(?: ([^)]+)\\)?\\([0-9a-z]+\\)  \\([-a-z0-9]+\\)  \\(.*\\)"
 	 "^commit *\\([0-9a-z]+\\)"))
   (set (make-local-variable 'log-view-font-lock-keywords)
-       (if vc-short-log
+       (if (eq vc-log-view-type 'short)
 	   '(
 	     ;; Same as log-view-message-re, except that we don't
 	     ;; want the shy group for the tag name.
--- a/lisp/vc-hg.el	Tue Apr 06 21:14:56 2010 -0700
+++ b/lisp/vc-hg.el	Tue Apr 06 22:56:35 2010 -0700
@@ -245,23 +245,23 @@
 (defvar log-view-file-re)
 (defvar log-view-font-lock-keywords)
 (defvar log-view-per-file-logs)
-(defvar vc-short-log)
 
 (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View"
   (require 'add-log) ;; we need the add-log faces
   (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)
-       (if vc-short-log
-           "^\\([0-9]+\\)\\(?:\\[.*\\]\\)? +\\([0-9a-z]\\{12\\}\\) +\\(\\(?:[0-9]+\\)-\\(?:[0-9]+\\)-\\(?:[0-9]+\\) \\(?:[0-9]+\\):\\(?:[0-9]+\\) \\(?:[-+0-9]+\\)\\) +\\(.*\\)$"
+       (if (eq vc-log-view-type 'short)
+           "^\\([0-9]+\\)\\(\\[.*\\]\\)? +\\([0-9a-z]\\{12\\}\\) +\\(\\(?:[0-9]+\\)-\\(?:[0-9]+\\)-\\(?:[0-9]+\\) \\(?:[0-9]+\\):\\(?:[0-9]+\\) \\(?:[-+0-9]+\\)\\) +\\(.*\\)$"
          "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)"))
   (set (make-local-variable 'log-view-font-lock-keywords)
-       (if vc-short-log
+       (if (eq vc-log-view-type 'short)
            (append `((,log-view-message-re
                       (1 'log-view-message-face)
-                      (2 'log-view-message-face)
-                      (3 'change-log-date)
-                      (4 'change-log-name))))
+                      (2 'highlight nil lax)
+                      (3 'log-view-message-face)
+                      (4 'change-log-date)
+                      (5 'change-log-name))))
        (append
         log-view-font-lock-keywords
         '(
@@ -277,7 +277,8 @@
           ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)"
            (1 'change-log-email))
           ("^date: \\(.+\\)" (1 'change-log-date))
-            ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
+	  ("^tag: +\\([^ ]+\\)$" (1 'highlight))
+	  ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
 
 (declare-function log-edit-mode "log-edit" ())
 (defvar log-edit-extra-flags)
@@ -454,8 +455,6 @@
 
 (defvar vc-hg-extra-menu-map
   (let ((map (make-sparse-keymap)))
-    (define-key map [incoming] '(menu-item "Show incoming" vc-hg-incoming))
-    (define-key map [outgoing] '(menu-item "Show outgoing" vc-hg-outgoing))
     map))
 
 (defun vc-hg-extra-menu () vc-hg-extra-menu-map)
@@ -464,14 +463,6 @@
 
 (defvar log-view-vc-backend)
 
-(define-derived-mode vc-hg-outgoing-mode vc-hg-log-view-mode "Hg-Outgoing"
-  "Mode for browsing Hg outgoing changes."
-  (set (make-local-variable 'log-view-vc-backend) 'Hg))
-
-(define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming"
-  "Mode for browsing Hg incoming changes."
-  (set (make-local-variable 'log-view-vc-backend) 'Hg))
-
 (defstruct (vc-hg-extra-fileinfo
             (:copier nil)
             (:constructor vc-hg-create-extra-fileinfo (rename-state extra-name))
@@ -577,33 +568,13 @@
      ;; (vc-hg-dir-extra-header "Global id  : " "id" "-i")
      )))
 
-;; FIXME: this adds another top level menu, instead figure out how to
-;; replace the Log-View menu.
-(easy-menu-define log-view-mode-menu vc-hg-outgoing-mode-map
-  "Hg-outgoing Display Menu"
-  `("Hg-outgoing"
-    ["Push selected"  vc-hg-push]))
-
-(easy-menu-define log-view-mode-menu vc-hg-incoming-mode-map
-  "Hg-incoming Display Menu"
-  `("Hg-incoming"
-    ["Pull selected"  vc-hg-pull]))
+(defun vc-hg-log-incoming (buffer remote-location)
+  (vc-hg-command buffer 1 nil "incoming" "-n" (unless (string= remote-location "")
+						remote-location)))
 
-(defun vc-hg-outgoing ()
-  (interactive)
-  (let ((bname "*Hg outgoing*")
-	(vc-short-log nil))
-    (vc-hg-command bname 1 nil "outgoing" "-n")
-    (pop-to-buffer bname)
-    (vc-hg-outgoing-mode)))
-
-(defun vc-hg-incoming ()
-  (interactive)
-  (let ((bname "*Hg incoming*")
-	(vc-short-log nil))
-    (vc-hg-command bname 0 nil "incoming" "-n")
-    (pop-to-buffer bname)
-    (vc-hg-incoming-mode)))
+(defun vc-hg-log-outgoing (buffer remote-location)
+  (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "")
+						remote-location)))
 
 (declare-function log-view-get-marked "log-view" ())
 
--- a/lisp/vc-hooks.el	Tue Apr 06 21:14:56 2010 -0700
+++ b/lisp/vc-hooks.el	Tue Apr 06 22:56:35 2010 -0700
@@ -981,6 +981,12 @@
     (define-key map [vc-update-change-log]
       `(menu-item ,(purecopy "Update ChangeLog") vc-update-change-log
 		  :help ,(purecopy "Find change log file and add entries from recent version control logs")))
+    (define-key map [vc-log-out]
+      `(menu-item ,(purecopy "Show Outgoing Log") vc-log-outgoing
+		  :help ,(purecopy "Show a log of changes that will be sent with a push operation")))
+    (define-key map [vc-log-in]
+      `(menu-item ,(purecopy "Show Incoming Log") vc-log-incoming
+		  :help ,(purecopy "Show a log of changes that will be received with a pull operation")))
     (define-key map [vc-print-log]
       `(menu-item ,(purecopy "Show History") vc-print-log
 		  :help ,(purecopy "List the change log of the current file set in a window")))
--- a/lisp/vc.el	Tue Apr 06 21:14:56 2010 -0700
+++ b/lisp/vc.el	Tue Apr 06 22:56:35 2010 -0700
@@ -345,6 +345,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
@@ -1891,6 +1901,29 @@
 (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)
+		  (limit limit))
+      (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,
@@ -1898,6 +1931,8 @@
   ;; buffer can be accessed by the command.
   (let ((dir-present nil)
 	(vc-short-log nil)
+	(buffer-name "*vc-change-log*")
+	type
 	pl-return)
     (dolist (file files)
       (when (file-directory-p file)
@@ -1906,44 +1941,64 @@
 	  (not (null (if dir-present
 			 (memq 'directory vc-log-short-style)
 		       (memq 'file vc-log-short-style)))))
+    (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))))))
 
-    (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*")
+(defvar vc-log-view-type nil
+  "Set this to differentiate the different types of logs.")
+(put 'vc-log-view-type 'permanent-local t)
+
+(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 'vc-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.
@@ -2004,6 +2059,32 @@
     (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