;;; vc-dispatcher.el -- generic command-dispatcher facility.
-;; Copyright (C) 2008
+;; Copyright (C) 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;;
;; The main interface to the lower level is vc-do-command. This launches a
;; command, synchronously or asynchronously, making the output available
-;; in a command log buffer. Two other functions, (vc-start-annotation) and
+;; in a command log buffer. Two other functions, (vc-start-logentry) and
;; (vc-finish-logentry), allow you to associate a command closure with an
;; annotation buffer so that when the user confirms the comment the closure
;; is run (with the comment as part of its context).
;; that on-disk files and the contents of their visiting Emacs buffers
;; coincide.
;;
-;; When the client mode adds a local mode-line-hook to a buffer, it
+;; When the client mode adds a local vc-mode-line-hook to a buffer, it
;; will be called with the buffer file name as argument whenever the
;; dispatcher resynchs the buffer.
(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
FILE-OR-LIST is the name of a working file; it may be a list of
files or be nil (to execute commands that don't expect a file
name or set of files). If an optional list of FLAGS is present,
-that is inserted into the command line before the filename."
+that is inserted into the command line before the filename.
+Return the return value of the slave command in the synchronous
+case, and the process object in the asynchronous case."
;; FIXME: file-relative-name can return a bogus result because
;; it doesn't look at the actual file-system to see if symlinks
;; come into play.
;; something, we'd have used vc-eval-after.
;; Use `delete-process' rather than `kill-process' because we don't
;; want any of its output to appear from now on.
- (if oldproc (delete-process oldproc)))
+ (when oldproc (delete-process oldproc)))
(let ((squeezed (remq nil flags))
(inhibit-read-only t)
(status 0))
(when files
(setq squeezed (nconc squeezed files)))
- (let ((exec-path (append vc-path exec-path))
- ;; Add vc-path to PATH for the execution of this command.
- (process-environment
- (cons (concat "PATH=" (getenv "PATH")
- path-separator
- (mapconcat 'identity vc-path path-separator))
- process-environment))
+ (let (;; Since some functions need to parse the output
+ ;; from external commands, set LC_MESSAGES to C.
+ (process-environment (cons "LC_MESSAGES=C" process-environment))
(w32-quote-process-args t))
- (when (and (eq okstatus 'async) (file-remote-p default-directory))
- ;; start-process does not support remote execution
- (setq okstatus nil))
(if (eq okstatus 'async)
;; Run asynchronously.
(let ((proc
(let ((process-connection-type nil))
(apply 'start-file-process command (current-buffer)
command squeezed))))
- (if vc-command-messages
- (message "Running %s in background..." full-command))
+ (when vc-command-messages
+ (message "Running %s in background..." full-command))
;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
(set-process-filter proc 'vc-process-filter)
- (vc-exec-after
- `(if vc-command-messages
- (message "Running %s in background... done" ',full-command))))
+ (setq status proc)
+ (when vc-command-messages
+ (vc-exec-after
+ `(message "Running %s in background... done" ',full-command))))
;; Run synchronously
(when vc-command-messages
(message "Running %s in foreground..." full-command))
(goto-char (point-min))
(shrink-window-if-larger-than-buffer))
(error "Running %s...FAILED (%s)" full-command
- (if (integerp status) (format "status %d" status) status))))
- ;; We're done. But don't emit a status message if running
- ;; asynchronously, it would just mislead.
- (if (and vc-command-messages (not (eq okstatus 'async)))
- (message "Running %s...OK = %d" full-command status)))
+ (if (integerp status) (format "status %d" status) status)))
+ (when vc-command-messages
+ (message "Running %s...OK = %d" full-command status))))
(vc-exec-after
`(run-hook-with-args 'vc-post-command-functions
',command ',file-or-list ',flags))
(revert-buffer arg no-confirm t))
(vc-restore-buffer-context context)))
-(defun vc-resynch-window (file &optional keep noquery)
+(defvar vc-mode-line-hook nil)
+(make-variable-buffer-local 'vc-mode-line-hook)
+(put 'vc-mode-line-hook 'permanent-local t)
+
+(defun vc-resynch-window (file &optional keep noquery reset-vc-info)
"If FILE is in the current buffer, either revert or unvisit it.
The choice between revert (to see expanded keywords) and unvisit
depends on KEEP. NOQUERY if non-nil inhibits confirmation for
editing!"
(and (string= buffer-file-name file)
(if keep
- (progn
+ (when (file-exists-p file)
+ (when reset-vc-info
+ (vc-file-clearprops file))
(vc-revert-buffer-internal t noquery)
- ;; TODO: Adjusting view mode might no longer be necessary
- ;; after RMS change to files.el of 1999-08-08. Investigate
- ;; this when we install the new VC.
+
+ ;; VC operations might toggle the read-only state. In
+ ;; that case we need to adjust the `view-mode' status
+ ;; when `view-read-only' is non-nil.
(and view-read-only
(if (file-writable-p file)
(and view-mode
(and (not view-mode)
(not (eq (get major-mode 'mode-class) 'special))
(view-mode-enter))))
- (run-hook-with-args 'mode-line-hook buffer-file-name))
+
+ ;; FIXME: Why use a hook? Why pass it buffer-file-name?
+ (run-hook-with-args 'vc-mode-line-hook buffer-file-name))
(kill-buffer (current-buffer)))))
(declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
(declare-function vc-string-prefix-p "vc" (prefix string))
-(defun vc-resynch-buffers-in-directory (directory &optional keep noquery)
+(defun vc-resynch-buffers-in-directory (directory &optional keep noquery reset-vc-info)
"Resync all buffers that visit files in DIRECTORY."
(dolist (buffer (buffer-list))
(let ((fname (buffer-file-name buffer)))
(when (and fname (vc-string-prefix-p directory fname))
- (vc-resynch-buffer fname keep noquery)))))
+ (with-current-buffer buffer
+ (vc-resynch-buffer fname keep noquery reset-vc-info))))))
-(defun vc-resynch-buffer (file &optional keep noquery)
+(defun vc-resynch-buffer (file &optional keep noquery reset-vc-info)
"If FILE is currently visited, resynch its buffer."
(if (string= buffer-file-name file)
- (vc-resynch-window file keep noquery)
+ (vc-resynch-window file keep noquery reset-vc-info)
(if (file-directory-p file)
- (vc-resynch-buffers-in-directory file keep noquery)
+ (vc-resynch-buffers-in-directory file keep noquery reset-vc-info)
(let ((buffer (get-file-buffer file)))
(when buffer
(with-current-buffer buffer
- (vc-resynch-window file keep noquery))))))
+ (vc-resynch-window file keep noquery reset-vc-info))))))
;; Try to avoid unnecessary work, a *vc-dir* buffer is only present
;; if this is true.
- (when (memq 'vc-dir-resynch-file after-save-hook)
+ (when vc-dir-buffers
(vc-dir-resynch-file file)))
(defun vc-buffer-sync (&optional not-urgent)
;; Set up key bindings for use while editing log messages
-(defun vc-log-edit (fileset)
+(defun vc-log-edit (fileset mode)
"Set up `log-edit' for use on FILE."
(setq default-directory
(with-current-buffer vc-parent-buffer default-directory))
(log-edit 'vc-finish-logentry
nil
- `((log-edit-listfun . (lambda () ',fileset))
- (log-edit-diff-function . (lambda () (vc-diff nil)))))
+ `((log-edit-listfun . (lambda ()
+ ;; FIXME: Should expand the list
+ ;; for directories.
+ (mapcar 'file-relative-name
+ ',fileset)))
+ (log-edit-diff-function . (lambda () (vc-diff nil))))
+ nil
+ mode)
(set (make-local-variable 'vc-log-fileset) fileset)
- (make-local-variable 'vc-log-extra)
(set-buffer-modified-p nil)
(setq buffer-file-name nil))
-(defun vc-start-logentry (files extra comment initial-contents msg logbuf action &optional after-hook)
- "Accept a comment for an operation on FILES with extra data EXTRA.
+(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook)
+ "Accept a comment for an operation on FILES.
If COMMENT is nil, pop up a LOGBUF 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
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'."
+\(current one if no file). Puts the log-entry buffer in major-mode
+MODE, defaulting to `log-edit-mode' if MODE is nil.
+AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'."
(let ((parent
(if (vc-dispatcher-browsing)
;; If we are called from a directory browser, the parent buffer is
(set (make-local-variable 'vc-parent-buffer) parent)
(set (make-local-variable 'vc-parent-buffer-name)
(concat " from " (buffer-name vc-parent-buffer)))
- (vc-log-edit files)
+ (vc-log-edit files mode)
(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)))
(vc-finish-logentry (eq comment t)))))
(declare-function vc-dir-move-to-goal-column "vc-dir" ())
-
+;; vc-finish-logentry is typically called from a log-edit buffer (see
+;; vc-start-logentry).
(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
(or (vc-dispatcher-browsing) (vc-buffer-sync)))
(unless vc-log-operation
(error "No log operation is pending"))
+
;; save the parameters held in buffer-local variables
(let ((logbuf (current-buffer))
(log-operation vc-log-operation)
+ ;; FIXME: When coming from VC-Dir, we should check that the
+ ;; set of selected files is still equal to vc-log-fileset,
+ ;; to avoid surprises.
(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))
+ (after-hook vc-log-after-operation-hook))
(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 log buffer and the typing therein).
(delete-windows-on logbuf (selected-frame))
;; Kill buffer and delete any other dedicated windows/frames.
(kill-buffer logbuf))
- (logbuf (pop-to-buffer logbuf)
- (bury-buffer)
- (pop-to-buffer tmp-vc-parent-buffer)))
+ (logbuf
+ (with-selected-window (or (get-buffer-window logbuf 0)
+ (selected-window))
+ (with-current-buffer logbuf
+ (bury-buffer)))))
;; Now make sure we see the expanded headers
(when log-fileset
(mapc
HCoop / bpt / emacs.git / blobdiff