changeset 94576:7de38dedf0a6

Move the command-closure machinery to vc-dispatcher.el.
author Eric S. Raymond <esr@snark.thyrsus.com>
date Sat, 03 May 2008 09:45:20 +0000
parents 02d980d4faf8
children 511a75ebd7df
files lisp/vc-dispatcher.el lisp/vc.el
diffstat 2 files changed, 125 insertions(+), 69 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/vc-dispatcher.el	Sat May 03 09:33:21 2008 +0000
+++ b/lisp/vc-dispatcher.el	Sat May 03 09:45:20 2008 +0000
@@ -76,6 +76,29 @@
 
 (provide 'vc-dispatcher)
 
+;; General customization
+
+(defcustom vc-logentry-check-hook nil
+  "Normal hook run by `vc-finish-logentry'.
+Use this to impose your own rules on the entry in addition to any the
+version control backend imposes itself."
+  :type 'hook
+  :group 'vc)
+
+;; Variables the user doesn't need to know about.
+(defvar vc-log-operation nil)
+(defvar vc-log-after-operation-hook nil)
+(defvar vc-log-fileset)
+(defvar vc-log-extra)
+
+;; In a log entry buffer, this is a local variable
+;; that points to the buffer for which it was made
+;; (either a file, or a VC dired buffer).
+(defvar vc-parent-buffer nil)
+(put 'vc-parent-buffer 'permanent-local t)
+(defvar vc-parent-buffer-name nil)
+(put 'vc-parent-buffer-name 'permanent-local t)
+
 ;; Common command execution logic
 
 (defun vc-process-filter (p s)
@@ -287,4 +310,102 @@
 			      ',command ',file-or-list ',flags))
 	status))))
 
+;; Command closures
+
+(defun vc-start-logentry (files extra comment initial-contents msg action &optional after-hook)
+  "Accept a comment for an operation on FILES with extra data EXTRA.
+If COMMENT is nil, pop up a VC-log buffer, emit MSG, and set the
+action on close to ACTION.  If COMMENT is a string and
+INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial
+contents of the log entry buffer.  If COMMENT is a string and
+INITIAL-CONTENTS is nil, do action immediately as if the user had
+entered COMMENT.  If COMMENT is t, also do action immediately with an
+empty comment.  Remember the file's buffer in `vc-parent-buffer'
+\(current one if no file).  AFTER-HOOK specifies the local value
+for `vc-log-after-operation-hook'."
+  (let ((parent
+         (if (or (eq major-mode 'vc-dired-mode) (eq major-mode 'vc-dir-mode))
+             ;; If we are called from VC dired, the parent buffer is
+             ;; the current buffer.
+             (current-buffer)
+           (if (and files (equal (length files) 1))
+               (get-file-buffer (car files))
+             (current-buffer)))))
+    (when vc-before-checkin-hook
+      (if files
+	  (with-current-buffer parent
+	    (run-hooks 'vc-before-checkin-hook))
+	(run-hooks 'vc-before-checkin-hook)))
+    (if (and comment (not initial-contents))
+	(set-buffer (get-buffer-create "*VC-log*"))
+      (pop-to-buffer (get-buffer-create "*VC-log*")))
+    (set (make-local-variable 'vc-parent-buffer) parent)
+    (set (make-local-variable 'vc-parent-buffer-name)
+	 (concat " from " (buffer-name vc-parent-buffer)))
+    ;;(if file (vc-mode-line file))
+    (vc-log-edit files)
+    (make-local-variable 'vc-log-after-operation-hook)
+    (when after-hook
+      (setq vc-log-after-operation-hook after-hook))
+    (setq vc-log-operation action)
+    (setq vc-log-extra extra)
+    (when comment
+      (erase-buffer)
+      (when (stringp comment) (insert comment)))
+    (if (or (not comment) initial-contents)
+	(message "%s  Type C-c C-c when done" msg)
+      (vc-finish-logentry (eq comment t)))))
+
+(defun vc-finish-logentry (&optional nocomment)
+  "Complete the operation implied by the current log entry.
+Use the contents of the current buffer as a check-in or registration
+comment.  If the optional arg NOCOMMENT is non-nil, then don't check
+the buffer contents as a comment."
+  (interactive)
+  ;; Check and record the comment, if any.
+  (unless nocomment
+    (run-hooks 'vc-logentry-check-hook))
+  ;; Sync parent buffer in case the user modified it while editing the comment.
+  ;; But not if it is a vc-dired buffer.
+  (with-current-buffer vc-parent-buffer
+    (or vc-dired-mode (eq major-mode 'vc-dir-mode) (vc-buffer-sync)))
+  (unless vc-log-operation
+    (error "No log operation is pending"))
+  ;; save the parameters held in buffer-local variables
+  (let ((log-operation vc-log-operation)
+	(log-fileset vc-log-fileset)
+	(log-extra vc-log-extra)
+	(log-entry (buffer-string))
+	(after-hook vc-log-after-operation-hook)
+	(tmp-vc-parent-buffer vc-parent-buffer))
+    (pop-to-buffer vc-parent-buffer)
+    ;; OK, do it to it
+    (save-excursion
+      (funcall log-operation
+	       log-fileset
+	       log-extra
+	       log-entry))
+    ;; Remove checkin window (after the checkin so that if that fails
+    ;; we don't zap the *VC-log* buffer and the typing therein).
+    ;; -- IMO this should be replaced with quit-window
+    (let ((logbuf (get-buffer "*VC-log*")))
+      (cond ((and logbuf vc-delete-logbuf-window)
+	     (delete-windows-on logbuf (selected-frame))
+	     ;; Kill buffer and delete any other dedicated windows/frames.
+	     (kill-buffer logbuf))
+	    (logbuf (pop-to-buffer "*VC-log*")
+		    (bury-buffer)
+		    (pop-to-buffer tmp-vc-parent-buffer))))
+    ;; Now make sure we see the expanded headers
+    (when log-fileset
+      (mapc
+       (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
+       log-fileset))
+    (when vc-dired-mode
+      (dired-move-to-filename))
+    (when (eq major-mode 'vc-dir-mode)
+      (vc-dir-move-to-goal-column))
+    (run-hooks after-hook 'vc-finish-logentry-hook)))
+
+
 ;;; vc-dispatcher.el ends here
--- a/lisp/vc.el	Sat May 03 09:33:21 2008 +0000
+++ b/lisp/vc.el	Sat May 03 09:45:20 2008 +0000
@@ -851,13 +851,6 @@
   :type 'hook
   :group 'vc)
 
-(defcustom vc-logentry-check-hook nil
-  "Normal hook run by `vc-finish-logentry'.
-Use this to impose your own rules on the entry in addition to any the
-version control backend imposes itself."
-  :type 'hook
-  :group 'vc)
-
 (defcustom vc-dir-mode-hook nil
   "Normal hook run by `vc-dir-mode'.
 See `run-hooks'."
@@ -990,26 +983,13 @@
                         "21.1")
 
 
-;; Variables the user doesn't need to know about.
-(defvar vc-log-operation nil)
-(defvar vc-log-after-operation-hook nil)
-
-;; In a log entry buffer, this is a local variable
-;; that points to the buffer for which it was made
-;; (either a file, or a VC dired buffer).
-(defvar vc-parent-buffer nil)
-(put 'vc-parent-buffer 'permanent-local t)
-(defvar vc-parent-buffer-name nil)
-(put 'vc-parent-buffer-name 'permanent-local t)
+;; Variables users don't need to see
 
 (defvar vc-disable-async-diff nil
   "VC sets this to t locally to disable some async diff operations.
 Backends that offer asynchronous diffs should respect this variable
 in their implementation of vc-BACKEND-diff.")
 
-(defvar vc-log-fileset)
-(defvar vc-log-revision)
-
 (defvar vc-dired-mode nil)
 (make-variable-buffer-local 'vc-dired-mode)
 
@@ -1630,7 +1610,7 @@
 		 (not (file-exists-p buffer-file-name)))
 	  (set-buffer-modified-p t))
 	(vc-buffer-sync)))
-    (vc-start-entry (list fname)
+    (vc-start-logentry (list fname)
 		    (if set-revision
 			(read-string (format "Initial revision level for %s: "
 					     fname))
@@ -1699,51 +1679,6 @@
     (let ((buffer (get-file-buffer file)))
       (vc-dir-mark-buffer-changed file))))
 
-
-(defun vc-start-entry (files rev comment initial-contents msg action &optional after-hook)
-  "Accept a comment for an operation on FILES revision REV.
-If COMMENT is nil, pop up a VC-log buffer, emit MSG, and set the
-action on close to ACTION.  If COMMENT is a string and
-INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial
-contents of the log entry buffer.  If COMMENT is a string and
-INITIAL-CONTENTS is nil, do action immediately as if the user had
-entered COMMENT.  If COMMENT is t, also do action immediately with an
-empty comment.  Remember the file's buffer in `vc-parent-buffer'
-\(current one if no file).  AFTER-HOOK specifies the local value
-for `vc-log-after-operation-hook'."
-  (let ((parent
-         (if (or (eq major-mode 'vc-dired-mode) (eq major-mode 'vc-dir-mode))
-             ;; If we are called from VC dired, the parent buffer is
-             ;; the current buffer.
-             (current-buffer)
-           (if (and files (equal (length files) 1))
-               (get-file-buffer (car files))
-             (current-buffer)))))
-    (when vc-before-checkin-hook
-      (if files
-	  (with-current-buffer parent
-	    (run-hooks 'vc-before-checkin-hook))
-	(run-hooks 'vc-before-checkin-hook)))
-    (if (and comment (not initial-contents))
-	(set-buffer (get-buffer-create "*VC-log*"))
-      (pop-to-buffer (get-buffer-create "*VC-log*")))
-    (set (make-local-variable 'vc-parent-buffer) parent)
-    (set (make-local-variable 'vc-parent-buffer-name)
-	 (concat " from " (buffer-name vc-parent-buffer)))
-    ;;(if file (vc-mode-line file))
-    (vc-log-edit files)
-    (make-local-variable 'vc-log-after-operation-hook)
-    (when after-hook
-      (setq vc-log-after-operation-hook after-hook))
-    (setq vc-log-operation action)
-    (setq vc-log-revision rev)
-    (when comment
-      (erase-buffer)
-      (when (stringp comment) (insert comment)))
-    (if (or (not comment) initial-contents)
-	(message "%s  Type C-c C-c when done" msg)
-      (vc-finish-logentry (eq comment t)))))
-
 (defun vc-checkout (file &optional writable rev)
   "Retrieve a copy of the revision REV of FILE.
 If WRITABLE is non-nil, make sure the retrieved file is writable.
@@ -1821,7 +1756,7 @@
 that the version control system supports this mode of operation.
 
 Runs the normal hook `vc-checkin-hook'."
-  (vc-start-entry
+  (vc-start-logentry
    files rev comment initial-contents
    "Enter a change comment."
    (lambda (files rev comment)
@@ -2214,7 +2149,7 @@
 
 (defun vc-modify-change-comment (files rev oldcomment)
   "Edit the comment associated with the given files and revision."
-  (vc-start-entry
+  (vc-start-logentry
    files rev oldcomment t
    "Enter a replacement change comment."
    (lambda (files rev comment)