;;; vc-dispatcher.el -- generic command-dispatcher facility.
-;; Copyright (C) 2008, 2009, 2010
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Eric S. Raymond <esr@thyrsus.com>
;; Keywords: vc tools
+;; Package: vc
;; This file is part of GNU Emacs.
;;
;; 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.
+;; dispatcher resyncs the buffer.
;; To do:
;;
command squeezed))))
(when vc-command-messages
(message "Running %s in background..." full-command))
- ;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
+ ;; Get rid of the default message insertion, in case we don't
+ ;; set a sentinel explicitly.
+ (set-process-sentinel proc #'ignore)
(set-process-filter proc 'vc-process-filter)
(setq status proc)
(when vc-command-messages
',command ',file-or-list ',flags))
status))))
+(defun vc-do-async-command (buffer root command &rest args)
+ "Run COMMAND asynchronously with ARGS, displaying the result.
+Send the output to BUFFER, which should be a buffer or the name
+of a buffer, which is created.
+ROOT should be the directory in which the command should be run.
+Display the buffer in some window, but don't select it."
+ (let* ((dir default-directory)
+ (inhibit-read-only t)
+ window new-window-start)
+ (setq buffer (get-buffer-create buffer))
+ (if (get-buffer-process buffer)
+ (error "Another VC action on %s is running" root))
+ (with-current-buffer buffer
+ (setq default-directory root)
+ (goto-char (point-max))
+ (unless (eq (point) (point-min))
+ (insert "\f\n"))
+ (setq new-window-start (point))
+ (insert "Running \"" command)
+ (dolist (arg args)
+ (insert " " arg))
+ (insert "\"...\n")
+ ;; Run in the original working directory.
+ (let ((default-directory dir))
+ (apply 'vc-do-command t 'async command nil args)))
+ (setq window (display-buffer buffer))
+ (if window
+ (set-window-start window new-window-start))
+ buffer))
+
+(defun vc-compilation-mode (backend)
+ "Setup `compilation-mode' after with the appropriate `compilation-error-regexp-alist'."
+ (let* ((error-regexp-alist
+ (vc-make-backend-sym backend 'error-regexp-alist))
+ (compilation-error-regexp-alist
+ (and (boundp error-regexp-alist)
+ (symbol-value error-regexp-alist))))
+ (compilation-mode)
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ compilation-error-regexp-alist)))
+
+(defun vc-set-async-update (process-buffer)
+ "Set a `vc-exec-after' action appropriate to the current buffer.
+This action will update the current buffer after the current
+asynchronous VC command has completed. PROCESS-BUFFER is the
+buffer for the asynchronous VC process.
+
+If the current buffer is a VC Dir buffer, call `vc-dir-refresh'.
+If the current buffer is a Dired buffer, revert it."
+ (let* ((buf (current-buffer))
+ (tick (buffer-modified-tick buf)))
+ (cond
+ ((derived-mode-p 'vc-dir-mode)
+ (with-current-buffer process-buffer
+ (vc-exec-after
+ `(if (buffer-live-p ,buf)
+ (with-current-buffer ,buf
+ (vc-dir-refresh))))))
+ ((derived-mode-p 'dired-mode)
+ (with-current-buffer process-buffer
+ (vc-exec-after
+ `(and (buffer-live-p ,buf)
+ (= (buffer-modified-tick ,buf) ,tick)
+ (with-current-buffer ,buf
+ (revert-buffer)))))))))
+
;; These functions are used to ensure that the view the user sees is up to date
;; even if the dispatcher client mode has messed with file contents (as in,
;; for example, VCS keyword expansion).
(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 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))
+ (when (and fname (string-prefix-p directory fname))
(with-current-buffer buffer
(vc-resynch-buffer fname keep noquery reset-vc-info))))))
;; Set up key bindings for use while editing log messages
-(defun vc-log-edit (fileset mode)
+(defun vc-log-edit (fileset mode backend)
"Set up `log-edit' for use on FILE."
(setq default-directory
- (with-current-buffer vc-parent-buffer default-directory))
+ (buffer-local-value 'default-directory vc-parent-buffer))
(log-edit 'vc-finish-logentry
nil
`((log-edit-listfun . (lambda ()
;; for directories.
(mapcar 'file-relative-name
',fileset)))
- (log-edit-diff-function . (lambda () (vc-diff nil))))
+ (log-edit-diff-function . vc-diff)
+ (log-edit-vc-backend . ,backend)
+ (vc-log-fileset . ,fileset))
nil
mode)
- (set (make-local-variable 'vc-log-fileset) fileset)
(set-buffer-modified-p nil)
(setq buffer-file-name nil))
-(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook)
+(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook backend)
"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
empty comment. Remember the file's buffer in `vc-parent-buffer'
\(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'."
+AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'.
+BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer."
(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 mode)
+ (vc-log-edit files mode backend)
(make-local-variable 'vc-log-after-operation-hook)
(when after-hook
(setq vc-log-after-operation-hook after-hook))
(funcall log-operation
log-fileset
log-entry))
- ;; Remove checkin window (after the checkin so that if that fails
- ;; we don't zap the log buffer and the typing therein).
- ;; -- IMO this should be replaced with quit-window
- (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
- (with-selected-window (or (get-buffer-window logbuf 0)
- (selected-window))
- (with-current-buffer logbuf
- (bury-buffer)))))
+
+ ;; Quit windows on logbuf.
+ (cond
+ ((not logbuf))
+ (vc-delete-logbuf-window
+ (quit-windows-on logbuf t (selected-frame)))
+ (t
+ (quit-windows-on logbuf nil 0)))
+
;; Now make sure we see the expanded headers
(when log-fileset
(mapc
(provide 'vc-dispatcher)
-;; arch-tag: 7d08b17f-5470-4799-914b-bfb9fcf6a246
;;; vc-dispatcher.el ends here
HCoop / bpt / emacs.git / blobdiff