mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
cd86307f26
* lisp/vc/vc-dispatcher.el (auto-revert-buffers): Delete. (vc-resynch-window): Always call vc-revert-buffer-internal. Calling auto-revert-buffers will not necessarily revert the current buffer, but we want it to happen synchronously.
1062 lines
46 KiB
EmacsLisp
1062 lines
46 KiB
EmacsLisp
;;; vc-dispatcher.el --- generic command-dispatcher facility. -*- lexical-binding: t -*-
|
||
|
||
;; Copyright (C) 2008-2025 Free Software Foundation, Inc.
|
||
|
||
;; Author: FSF (see below for full credits)
|
||
;; Keywords: vc tools
|
||
;; Package: vc
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Credits:
|
||
|
||
;; Designed and implemented by Eric S. Raymond, originally as part of VC mode.
|
||
;; Stefan Monnier and Dan Nicolaescu contributed substantial work on the
|
||
;; vc-dir front end.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Goals:
|
||
;;
|
||
;; There is a class of front-ending problems that Emacs might be used
|
||
;; to address that involves selecting sets of files, or possibly
|
||
;; directories, and passing the selection set to slave commands. The
|
||
;; prototypical example, from which this code is derived, is talking
|
||
;; to version-control systems.
|
||
;;
|
||
;; vc-dispatcher.el is written to decouple the UI issues in such front
|
||
;; ends from their application-specific logic. It also provides a
|
||
;; service layer for running the slave commands either synchronously
|
||
;; or asynchronously and managing the message/error logs from the
|
||
;; command runs.
|
||
;;
|
||
;; Similar UI problems can be expected to come up in applications
|
||
;; areas other than VCSes; IDEs and document search are two obvious ones.
|
||
;; This mode is intended to ensure that the Emacs interfaces for all such
|
||
;; beasts are consistent and carefully designed. But even if nothing
|
||
;; but VC ever uses it, getting the layer separation right will be
|
||
;; a valuable thing.
|
||
|
||
;; Dispatcher's universe:
|
||
;;
|
||
;; The universe consists of the file tree rooted at the current
|
||
;; directory. The dispatcher's upper layer deduces some subset
|
||
;; of the file tree from the state of the currently visited buffer
|
||
;; and returns that subset, presumably to a client mode.
|
||
;;
|
||
;; The user may be looking at either of two different views; a buffer
|
||
;; visiting a file, or a directory buffer generated by vc-dispatcher.
|
||
;;
|
||
;; The lower layer of this mode runs commands in subprocesses, either
|
||
;; synchronously or asynchronously. Commands may be launched in one
|
||
;; of two ways: they may be run immediately, or the calling mode can
|
||
;; create a closure associated with a text-entry buffer, to be
|
||
;; executed when the user types C-c to ship the buffer contents. In
|
||
;; either case the command messages and error (if any) will remain
|
||
;; available in a status buffer.
|
||
|
||
;; Special behavior of dispatcher directory buffers:
|
||
;;
|
||
;; In dispatcher directory buffers, facilities to perform basic
|
||
;; navigation and selection operations are provided by keymap and menu
|
||
;; entries that dispatcher sets up itself, so they'll be uniform
|
||
;; across all dispatcher-using client modes. Client modes are
|
||
;; expected to append to these to provide mode-specific bindings.
|
||
;;
|
||
;; The standard map associates a 'state' slot (that the client mode
|
||
;; may set) with each directory entry. The dispatcher knows nothing
|
||
;; about the semantics of individual states, but mark and unmark commands
|
||
;; treat all entries with the same state as the currently selected one as
|
||
;; a unit.
|
||
|
||
;; The interface:
|
||
;;
|
||
;; 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-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).
|
||
;;
|
||
;; The interface to the upper level has the two main entry points (vc-dir)
|
||
;; and (vc-dispatcher-selection-set) and a couple of convenience functions.
|
||
;; (vc-dir) sets up a dispatcher browsing buffer; (vc-dispatcher-selection-set)
|
||
;; returns a selection set of files, either the marked files in a browsing
|
||
;; buffer or the singleton set consisting of the file visited by the current
|
||
;; buffer (when that is appropriate). It also does what is needed to ensure
|
||
;; that on-disk files and the contents of their visiting Emacs buffers
|
||
;; coincide.
|
||
;;
|
||
;; 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 resyncs the buffer.
|
||
|
||
;;; Code:
|
||
|
||
(eval-when-compile
|
||
(require 'cl-lib)
|
||
(require 'cl-print))
|
||
|
||
;; 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
|
||
dispatcher client mode imposes itself."
|
||
:type 'hook
|
||
:group 'vc)
|
||
|
||
;; This hook was undeclared and undocumented until declared obsolete.
|
||
;; I believe it can be replaced with `vc-log-after-operation-hook'; if
|
||
;; someone can demonstrate a case where this is wanted too, we can
|
||
;; unobsolete it. --spwhitton
|
||
(defvar vc-finish-logentry-hook nil
|
||
"Additional hook run at the end of `vc-finish-logentry'.")
|
||
(make-obsolete-variable 'vc-finish-logentry-hook 'vc-log-after-operation-hook
|
||
"31.1" 'set)
|
||
|
||
(defcustom vc-delete-logbuf-window t
|
||
"If non-nil, delete the log buffer and window after each logical action.
|
||
If nil, bury that buffer instead.
|
||
This is most useful if you have multiple windows on a frame and would like to
|
||
preserve the setting."
|
||
:type 'boolean
|
||
:group 'vc)
|
||
|
||
(defcustom vc-command-messages nil
|
||
"If non-nil, display and log messages about running back-end commands.
|
||
If the value is `log', messages about running VC back-end commands are
|
||
logged in the *Messages* buffer, but not displayed."
|
||
:type '(choice (const :tag "No messages" nil)
|
||
(const :tag "Display and log messages" t)
|
||
(const :tag "Log messages, but don't display" log))
|
||
:group 'vc)
|
||
|
||
(defcustom vc-suppress-confirm nil
|
||
"If non-nil, treat user as expert; suppress yes-no prompts on some things."
|
||
:type 'boolean
|
||
:group 'vc)
|
||
|
||
;; Variables the user doesn't need to know about.
|
||
|
||
(defvar vc-log-operation nil)
|
||
(defvar vc-log-after-operation-hook nil
|
||
"Name of the hook run at the end of `vc-finish-logentry'.
|
||
BEWARE: Despite its name, this variable is not itself a hook!")
|
||
(defvar vc-log-fileset)
|
||
|
||
;; 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 directory 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)
|
||
"An alternative output filter for async process P.
|
||
One difference with the default filter is that this inserts S after markers.
|
||
Another is that undo information is not kept."
|
||
(let ((buffer (process-buffer p)))
|
||
(when (buffer-live-p buffer)
|
||
(with-current-buffer buffer
|
||
(save-excursion
|
||
(let ((buffer-undo-list t)
|
||
(inhibit-read-only t))
|
||
(goto-char (process-mark p))
|
||
(insert s)
|
||
(set-marker (process-mark p) (point))))))))
|
||
|
||
(defun vc-setup-buffer (buf)
|
||
"Prepare BUF for executing a slave command and make it current."
|
||
(let ((camefrom (current-buffer))
|
||
(olddir default-directory)
|
||
(buf (get-buffer-create buf)))
|
||
(set-buffer buf)
|
||
(let ((oldproc (get-buffer-process (current-buffer))))
|
||
;; If we wanted to wait for oldproc to finish before doing
|
||
;; 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.
|
||
(when oldproc (delete-process oldproc)))
|
||
(kill-all-local-variables)
|
||
;; Kill also this permanent local var in case the VC command that
|
||
;; created BUF was invoked from a different directory (bug#44698).
|
||
(kill-local-variable 'file-local-variables-alist)
|
||
;; If we are refreshing an existing view,
|
||
;; don't throw away where we really came from (bug#59457).
|
||
(unless (eq camefrom (current-buffer))
|
||
(setq-local vc-parent-buffer camefrom)
|
||
(setq-local vc-parent-buffer-name
|
||
(concat " from " (buffer-name camefrom))))
|
||
|
||
(set-buffer-local-toplevel-value 'default-directory olddir)
|
||
(let ((buffer-undo-list t)
|
||
(inhibit-read-only t))
|
||
(erase-buffer))))
|
||
|
||
(defvar vc-sentinel-movepoint)
|
||
|
||
(defun vc-set-mode-line-busy-indicator ()
|
||
(setq mode-line-process
|
||
(concat " " (propertize "[waiting...]"
|
||
'face 'mode-line-emphasis
|
||
'help-echo
|
||
"A command is in progress in this buffer"))))
|
||
|
||
(defun vc-exec-after (code &optional success proc)
|
||
"Execute CODE when PROC, or the current buffer's process, is done.
|
||
CODE should be a function of no arguments.
|
||
CODE a bare form to pass to `eval' is also supported for compatibility.
|
||
|
||
The optional PROC argument specifies the process Emacs should wait for
|
||
before executing CODE. It defaults to the current buffer's process.
|
||
If PROC is nil and the current buffer has no process, just evaluate
|
||
CODE. Otherwise, add CODE to the process's sentinel.
|
||
|
||
If SUCCESS, it should be a process object.
|
||
Only run CODE if the SUCCESS process has a zero exit code."
|
||
(unless proc (setq proc (get-buffer-process (current-buffer))))
|
||
(letrec ((eval-code
|
||
(lambda ()
|
||
(when (or (not success)
|
||
(zerop (process-exit-status success)))
|
||
(if (functionp code) (funcall code) (eval code t)))))
|
||
(buf (and proc (process-buffer proc)))
|
||
(fun
|
||
(lambda (proc _msg)
|
||
;; In the unlikely event of `set-buffer-process'.
|
||
(setq buf (process-buffer proc))
|
||
(cond
|
||
;; Impatient users sometime kill "slow" buffers; check
|
||
;; liveness to avoid "error in process sentinel:
|
||
;; Selecting deleted buffer".
|
||
((not (buffer-live-p buf))
|
||
(remove-function (process-sentinel proc) fun))
|
||
((eq (process-status proc) 'exit)
|
||
(with-current-buffer buf
|
||
(setq mode-line-process nil)
|
||
(let (vc-sentinel-movepoint
|
||
(m (process-mark proc)))
|
||
;; Normally, we want async code such as sentinels to
|
||
;; not move point.
|
||
(save-excursion
|
||
(goto-char m)
|
||
;; Each sentinel may move point and the next one
|
||
;; should be run from that new position.
|
||
;; Handling this up here, instead of requiring
|
||
;; CODE to handle it, means CODE can be written
|
||
;; for both sync and async processes.
|
||
(funcall eval-code)
|
||
(move-marker m (point)))
|
||
;; But sometimes the sentinels really want to move point.
|
||
(when vc-sentinel-movepoint
|
||
(if-let* ((win (get-buffer-window (current-buffer) 0)))
|
||
(with-selected-window win
|
||
(goto-char vc-sentinel-movepoint))
|
||
(goto-char vc-sentinel-movepoint))))))
|
||
((not (eq (process-status proc) 'run))
|
||
(remove-function (process-sentinel proc) fun)
|
||
(error "Unexpected process state"))))))
|
||
(cond
|
||
;; If there's no background process, just execute the code.
|
||
;; We used to explicitly call delete-process on exited processes,
|
||
;; but this led to timing problems causing process output to be
|
||
;; lost. Terminated processes get deleted automatically
|
||
;; anyway. -- cyd
|
||
((or (null proc) (eq (process-status proc) 'exit))
|
||
(when proc (accept-process-output proc))
|
||
(funcall eval-code))
|
||
((eq (process-status proc) 'run)
|
||
(when (buffer-live-p buf)
|
||
(with-current-buffer buf
|
||
(vc-set-mode-line-busy-indicator)))
|
||
(add-function :after (process-sentinel proc) fun))
|
||
(t (error "Unexpected process state"))))
|
||
nil)
|
||
|
||
(defmacro vc-run-delayed (&rest body)
|
||
(declare (indent 0) (debug (def-body)))
|
||
`(vc-exec-after (lambda () ,@body)))
|
||
|
||
(defun vc-wait-for-process-before-save (proc message)
|
||
"Make Emacs wait for PROC before saving buffers under current VC tree.
|
||
If waiting for PROC takes more than a second, display MESSAGE.
|
||
|
||
This is used to implement `vc-async-checkin'. It effectively switches
|
||
to a synchronous checkin in the case that the user asks to save a buffer
|
||
under the tree in which the checkin operation is running.
|
||
|
||
The hook installed by this function will make Emacs unconditionally wait
|
||
for PROC if the root of the current VC tree couldn't be determined, and
|
||
whenever writing out a buffer which doesn't have any `buffer-file-name'
|
||
yet."
|
||
(letrec ((root (vc-root-dir))
|
||
(hook
|
||
(lambda ()
|
||
(cond ((not (process-live-p proc))
|
||
(remove-hook 'before-save-hook hook))
|
||
((or (and buffer-file-name
|
||
(or (not root)
|
||
(file-in-directory-p buffer-file-name
|
||
root)))
|
||
;; No known buffer file name but we are saving:
|
||
;; perhaps writing out a `special-mode' buffer.
|
||
;; A `before-save-hook' cannot know whether or
|
||
;; not it'll be written out under ROOT.
|
||
;; Err on the side of switching to synchronous.
|
||
(not buffer-file-name))
|
||
(with-delayed-message (1 message)
|
||
(while (process-live-p proc)
|
||
(when (input-pending-p)
|
||
(discard-input))
|
||
(sit-for 0.05)))
|
||
(remove-hook 'before-save-hook hook))))))
|
||
(add-hook 'before-save-hook hook)))
|
||
|
||
(defvar vc-filter-command-function #'list
|
||
"Function called to transform VC commands before execution.
|
||
The function is called inside the buffer in which the command
|
||
will be run and is passed the COMMAND, FILE-OR-LIST and FLAGS
|
||
arguments to `vc-do-command'. It should return a list of three
|
||
elements, the new values for these arguments.")
|
||
|
||
(defvar vc-post-command-functions nil
|
||
"Hook run at the end of `vc-do-command'.
|
||
Each function is called inside the buffer in which the command was run
|
||
and is passed 3 arguments: the COMMAND, the FILES and the FLAGS.")
|
||
|
||
(defvar w32-quote-process-args)
|
||
|
||
(defun vc-delistify (filelist)
|
||
"Smash a FILELIST into a file list string suitable for info messages."
|
||
;; FIXME what about file names with spaces?
|
||
(if (not filelist) "." (mapconcat #'identity filelist " ")))
|
||
|
||
(defcustom vc-tor nil
|
||
"If non-nil, communicate with the repository site via Tor.
|
||
See https://2019.www.torproject.org/about/overview.html.en and
|
||
the man pages for \"torsocks\" for more details about Tor."
|
||
:type 'boolean
|
||
:version "27.1"
|
||
:group 'vc)
|
||
|
||
(defun vc-user-edit-command (command file-or-list flags)
|
||
"Prompt the user to edit VC command COMMAND and FLAGS.
|
||
Intended to be used as the value of `vc-filter-command-function'."
|
||
(let* ((files-separator-p (string= "--" (car (last flags))))
|
||
(edited (split-string-and-unquote
|
||
(read-shell-command
|
||
(format "Edit VC command & arguments%s: "
|
||
(if file-or-list
|
||
" (files list to be appended)"
|
||
""))
|
||
(concat (combine-and-quote-strings
|
||
(cons command (remq nil (if files-separator-p
|
||
(butlast flags)
|
||
flags))))
|
||
" ")))))
|
||
(list (car edited) file-or-list
|
||
(nconc (cdr edited) (and files-separator-p '("--"))))))
|
||
|
||
;;;###autoload
|
||
(defun vc-do-command (destination okstatus command file-or-list &rest flags)
|
||
"Execute an inferior command, notifying user and checking for errors.
|
||
|
||
DESTINATION specifies what to do with COMMAND's output. It can be a
|
||
buffer or the name of a buffer to insert output there, t to mean the
|
||
current buffer, or nil to discard output.
|
||
DESTINATION can also have the form (REAL-BUFFER STDERR-FILE); in that
|
||
case, REAL-BUFFER says what to do with standard output, as above, while
|
||
STDERR-FILE says what to do with standard error in the child.
|
||
STDERR-FILE may only be nil which means to discard standard error
|
||
output or t which means to mix it with standard output.
|
||
If the destination for standard output is a buffer that is not the
|
||
current buffer, set up the buffer properly and erase it.
|
||
|
||
OKSTATUS `async' means not to wait for termination of the subprocess and
|
||
return the process object. Otherwise, OKSTATUS determines when to
|
||
signal an error instead of returning a numeric exit status or signal
|
||
description string. OKSTATUS an integer means to signal an error if the
|
||
command's exit status exceeds that value or the command is killed by a
|
||
signal, nil means to signal an error only if the command is killed by a
|
||
signal, and t means never to signal an error.
|
||
|
||
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."
|
||
;; STDERR-FILE is limited to nil or t, instead of also supporting
|
||
;; putting stderr output into a buffer or file, because of how we
|
||
;; support both synchronous and asynchronous execution.
|
||
;; `call-process' supports STDERR-FILE being a file name but not a
|
||
;; buffer, while `make-process' with `:file-handler' non-nil supports
|
||
;; putting stderr output in a buffer but not in a file (see Info node
|
||
;; `(elisp) Asynchronous Processes' for this detail). I.e. the only
|
||
;; options supported by both `call-process' and `make-process' are
|
||
;; discarding stderr output or mixing it with stdout.
|
||
(cl-assert (or (atom destination)
|
||
(and (length= destination 2)
|
||
(memq (cadr destination) '(t nil))))
|
||
nil
|
||
"Invalid DESTINATION argument to `vc-do-command': %s"
|
||
destination)
|
||
(pcase-let (;; Keep entire commands in *Messages* but avoid resizing the
|
||
;; echo area. Messages in this function are formatted in
|
||
;; a such way that the important parts are at the beginning,
|
||
;; due to potential truncation of long messages.
|
||
(message-truncate-lines t)
|
||
(vc-inhibit-message
|
||
(or (eq vc-command-messages 'log)
|
||
(eq (selected-window) (active-minibuffer-window))))
|
||
|
||
(`(,command ,file-or-list ,flags)
|
||
(funcall vc-filter-command-function
|
||
command file-or-list flags))
|
||
((or `(,stdout ,stderr) (and stdout (let stderr t)))
|
||
destination))
|
||
(save-current-buffer
|
||
(unless (or (memq stdout '(t nil))
|
||
(eq (current-buffer) (get-buffer stdout)))
|
||
(vc-setup-buffer stdout)
|
||
(setq stdout t))
|
||
(when vc-tor
|
||
(push command flags)
|
||
(setq command "torsocks"))
|
||
(let* (;; 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.
|
||
(files
|
||
(mapcar (lambda (f)
|
||
(file-relative-name (expand-file-name f)))
|
||
(ensure-list file-or-list)))
|
||
(full-command
|
||
(concat (if (equal (substring command -1) "\n")
|
||
(substring command 0 -1)
|
||
command)
|
||
" " (vc-delistify flags)
|
||
(and files (concat " " (vc-delistify files)))))
|
||
(squeezed (remq nil flags))
|
||
(inhibit-read-only t)
|
||
(status 0))
|
||
;; If there's some previous async process still running,
|
||
;; just kill it.
|
||
(when files
|
||
(setq squeezed (nconc squeezed files)))
|
||
(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))
|
||
(if (eq okstatus 'async)
|
||
;; Run asynchronously.
|
||
(let* ((stderr-buf
|
||
(and (not stderr)
|
||
(generate-new-buffer " *temp*" t)))
|
||
(proc
|
||
(make-process :name command
|
||
:buffer (and stdout (current-buffer))
|
||
:command (cons command squeezed)
|
||
:connection-type 'pipe
|
||
:filter #'vc-process-filter
|
||
:sentinel #'ignore
|
||
:stderr stderr-buf
|
||
:file-handler t)))
|
||
(when stderr-buf
|
||
(vc-run-delayed (kill-buffer stderr-buf)))
|
||
(when vc-command-messages
|
||
(let ((inhibit-message vc-inhibit-message))
|
||
(message "Running in background: %s"
|
||
full-command)))
|
||
(setq status proc)
|
||
(when vc-command-messages
|
||
(vc-run-delayed
|
||
(let ((message-truncate-lines t)
|
||
(inhibit-message vc-inhibit-message))
|
||
(message "Done in background: %s"
|
||
full-command)))))
|
||
;; Run synchronously
|
||
(when vc-command-messages
|
||
(let ((inhibit-message vc-inhibit-message))
|
||
(message "Running in foreground: %s" full-command)))
|
||
(let ((buffer-undo-list t))
|
||
(setq status (apply #'process-file command nil
|
||
(list stdout stderr) nil squeezed)))
|
||
(when (and (not (eq t okstatus))
|
||
(or (not (integerp status))
|
||
(and okstatus (< okstatus status))))
|
||
(unless (eq ?\s (aref (buffer-name (current-buffer)) 0))
|
||
(pop-to-buffer (current-buffer))
|
||
(goto-char (point-min))
|
||
(shrink-window-if-larger-than-buffer))
|
||
(when-let* (noninteractive
|
||
(out (string-trim (buffer-string))))
|
||
(unless (string-empty-p out)
|
||
(message "%s" out)))
|
||
(error "Failed (%s): %s"
|
||
(if (integerp status)
|
||
(format "status %d" status)
|
||
status)
|
||
full-command))
|
||
(when vc-command-messages
|
||
(let ((inhibit-message vc-inhibit-message))
|
||
(message "Done (status=%d): %s"
|
||
status full-command)))))
|
||
(vc-run-delayed
|
||
(run-hook-with-args 'vc-post-command-functions
|
||
command file-or-list flags))
|
||
status))))
|
||
|
||
(defvar vc--inhibit-async-window nil)
|
||
|
||
(defun vc--display-async-command-buffer (buffer)
|
||
(unless vc--inhibit-async-window
|
||
(when-let* ((window (display-buffer buffer))
|
||
(start (with-current-buffer buffer
|
||
(save-excursion
|
||
(goto-char (point-max))
|
||
(and (re-search-backward " \n" nil t)
|
||
(match-end 0))))))
|
||
(set-window-start window start))))
|
||
|
||
(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.
|
||
The process object is returned.
|
||
Display the buffer in some window, but don't select it."
|
||
(letrec ((dir default-directory)
|
||
(start-time) (proc)
|
||
(finished-fun
|
||
(lambda (proc _msg)
|
||
(cond ((not (buffer-live-p buffer))
|
||
(remove-function (process-sentinel proc)
|
||
finished-fun))
|
||
((not (eq (process-status proc) 'run))
|
||
(remove-function (process-sentinel proc)
|
||
finished-fun)
|
||
(with-current-buffer buffer
|
||
(save-excursion
|
||
(goto-char (process-mark proc))
|
||
(let ((inhibit-read-only t))
|
||
(insert
|
||
(format "Finished in %.2f seconds\n"
|
||
(time-to-seconds
|
||
(time-since start-time))))
|
||
(set-marker (process-mark proc)
|
||
(point))))))))))
|
||
(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)
|
||
(let* (;; Run in the original working directory.
|
||
(default-directory dir)
|
||
(orig-fun vc-filter-command-function)
|
||
(inhibit-read-only t)
|
||
(vc-filter-command-function
|
||
(lambda (&rest args)
|
||
(cl-destructuring-bind (&whole args cmd _ flags)
|
||
(apply orig-fun args)
|
||
(goto-char (point-max))
|
||
(unless (eq (point) (point-min))
|
||
(insert " \n"))
|
||
(insert "Running '" cmd)
|
||
(dolist (flag flags)
|
||
(let ((lines (string-lines flag)))
|
||
(insert " ")
|
||
;; If the argument has newlines in it (as a commit
|
||
;; message commonly will) then ellipse it down so
|
||
;; that the whole command is more readable.
|
||
(if (cdr lines)
|
||
(let ((flag (copy-sequence flag))
|
||
(cl-print-string-length (length
|
||
(car lines))))
|
||
(set-text-properties 0 (length flag) nil
|
||
flag)
|
||
(cl-prin1 flag buffer))
|
||
(insert flag))))
|
||
(insert "'...\n")
|
||
args))))
|
||
(setq start-time (current-time)
|
||
proc (apply #'vc-do-command t 'async command nil args))))
|
||
(add-function :after (process-sentinel proc) finished-fun)
|
||
(vc--display-async-command-buffer buffer)
|
||
proc))
|
||
|
||
(defvar compilation-error-regexp-alist)
|
||
|
||
(defvar vc-compilation-mode-hook nil
|
||
"Hook run after entering `vc-compilation-mode'.
|
||
No problems result if this variable is not bound.
|
||
`add-hook' automatically binds it. (This is true for all hook variables.)")
|
||
|
||
(derived-mode-set-parent 'vc-compilation-mode 'compilation-mode)
|
||
|
||
(defun vc-compilation-mode (backend)
|
||
"Compilation mode for buffers with output from VC commands.
|
||
Sets `compilation-error-regexp-alist' in accordance with the VC backend."
|
||
(delay-mode-hooks
|
||
(let* ((error-regexp-alist
|
||
(vc-make-backend-sym backend 'error-regexp-alist))
|
||
(error-regexp-alist (and (boundp error-regexp-alist)
|
||
(symbol-value error-regexp-alist))))
|
||
(let ((compilation-error-regexp-alist error-regexp-alist))
|
||
(compilation-mode)
|
||
(setq mode-name "VC-Compilation"
|
||
major-mode 'vc-compilation-mode))
|
||
(setq-local compilation-error-regexp-alist
|
||
error-regexp-alist)))
|
||
(run-mode-hooks 'vc-compilation-mode-hook))
|
||
|
||
(declare-function vc-dir-refresh "vc-dir" ())
|
||
|
||
(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.
|
||
If the current buffer visits a file, call `vc-refresh-state'."
|
||
(let* ((buf (current-buffer))
|
||
(tick (buffer-modified-tick buf)))
|
||
(cl-macrolet ((run-delayed (&rest body)
|
||
`(with-current-buffer process-buffer
|
||
(vc-run-delayed
|
||
(when (buffer-live-p buf)
|
||
(with-current-buffer buf
|
||
,@body))))))
|
||
(cond ((derived-mode-p 'vc-dir-mode)
|
||
(run-delayed (vc-dir-refresh)))
|
||
((derived-mode-p 'dired-mode)
|
||
(run-delayed
|
||
(when (= (buffer-modified-tick buf) tick)
|
||
(revert-buffer))))
|
||
(buffer-file-name
|
||
(run-delayed (vc-refresh-state)))))))
|
||
|
||
;; 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).
|
||
|
||
(declare-function view-mode-exit "view" (&optional exit-only exit-action all-win))
|
||
|
||
(defun vc-position-context (posn)
|
||
"Save a bit of the text around POSN in the current buffer.
|
||
Used to help us find the corresponding position again later
|
||
if markers are destroyed or corrupted."
|
||
;; A lot of this was shamelessly lifted from Sebastian Kremer's
|
||
;; rcs.el mode.
|
||
(list posn
|
||
(buffer-size)
|
||
(buffer-substring posn
|
||
(min (point-max) (+ posn 100)))))
|
||
|
||
(defun vc-find-position-by-context (context)
|
||
"Return the position of CONTEXT in the current buffer.
|
||
If CONTEXT cannot be found, return nil."
|
||
(let ((context-string (nth 2 context)))
|
||
(if (equal "" context-string)
|
||
(point-max)
|
||
(save-excursion
|
||
(let ((diff (- (nth 1 context) (buffer-size))))
|
||
(when (< diff 0) (setq diff (- diff)))
|
||
(goto-char (nth 0 context))
|
||
(if (or (search-forward context-string nil t)
|
||
;; Can't use search-backward since the match may continue
|
||
;; after point.
|
||
(progn (goto-char (- (point) diff (length context-string)))
|
||
;; goto-char doesn't signal an error at
|
||
;; beginning of buffer like backward-char would
|
||
(search-forward context-string nil t)))
|
||
;; to beginning of OSTRING
|
||
(- (point) (length context-string))))))))
|
||
|
||
(defun vc-context-matches-p (posn context)
|
||
"Return t if POSN matches CONTEXT, nil otherwise."
|
||
(let* ((context-string (nth 2 context))
|
||
(len (length context-string))
|
||
(end (+ posn len)))
|
||
(if (> end (1+ (buffer-size)))
|
||
nil
|
||
(string= context-string (buffer-substring posn end)))))
|
||
|
||
(defun vc-buffer-context ()
|
||
"Return a list (POINT-CONTEXT MARK-CONTEXT REPARSE).
|
||
Used by `vc-restore-buffer-context' to later restore the context."
|
||
(let ((point-context (vc-position-context (point)))
|
||
;; Use mark-marker to avoid confusion in transient-mark-mode.
|
||
(mark-context (when (eq (marker-buffer (mark-marker)) (current-buffer))
|
||
(vc-position-context (mark-marker))))
|
||
;; Make the right thing happen in transient-mark-mode.
|
||
(mark-active nil))
|
||
(list point-context mark-context)))
|
||
|
||
(defun vc-restore-buffer-context (context)
|
||
"Restore point/mark, and reparse any affected compilation buffers.
|
||
CONTEXT is that which `vc-buffer-context' returns."
|
||
(let ((point-context (nth 0 context))
|
||
(mark-context (nth 1 context)))
|
||
;; if necessary, restore point and mark
|
||
(if (not (vc-context-matches-p (point) point-context))
|
||
(let ((new-point (vc-find-position-by-context point-context)))
|
||
(when new-point (goto-char new-point))))
|
||
(and mark-active
|
||
mark-context
|
||
(not (vc-context-matches-p (mark) mark-context))
|
||
(let ((new-mark (vc-find-position-by-context mark-context)))
|
||
(when new-mark (set-mark new-mark))))))
|
||
|
||
(defun vc-revert-buffer-internal (&optional arg no-confirm)
|
||
"Revert buffer keeping point and the mark where the user expects them.
|
||
Try to be clever in the face of changes due to expanded VCS
|
||
keywords (cf., e.g., Info node `(cvs)Keyword substitution').
|
||
This is important for typeahead to work as expected.
|
||
ARG and NO-CONFIRM are passed on to `revert-buffer'."
|
||
(interactive "P")
|
||
(widen)
|
||
(let ((context (vc-buffer-context)))
|
||
;; Use save-excursion here, because it may be able to restore point
|
||
;; and mark properly even in cases where vc-restore-buffer-context
|
||
;; would fail. However, save-excursion might also get it wrong --
|
||
;; in this case, vc-restore-buffer-context gives it a second try.
|
||
(save-excursion
|
||
;; t means don't call normal-mode;
|
||
;; that's to preserve various minor modes.
|
||
(revert-buffer arg no-confirm t))
|
||
(vc-restore-buffer-context context)))
|
||
|
||
(defvar-local vc-mode-line-hook nil)
|
||
(put 'vc-mode-line-hook 'permanent-local t)
|
||
|
||
(defvar view-old-buffer-read-only)
|
||
|
||
(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
|
||
reverting. NOQUERY should be t *only* if it is known the only
|
||
difference between the buffer and the file is due to
|
||
modifications by the dispatcher client code, rather than user
|
||
editing!"
|
||
(and (equal buffer-file-name
|
||
(if (file-name-absolute-p file)
|
||
file
|
||
(expand-file-name file (vc-root-dir))))
|
||
(cond ((not keep)
|
||
(kill-buffer))
|
||
((file-exists-p file)
|
||
(when reset-vc-info
|
||
(vc-file-clearprops file))
|
||
(vc-revert-buffer-internal t noquery)
|
||
|
||
;; 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
|
||
(let ((view-old-buffer-read-only nil))
|
||
(view-mode-exit t)))
|
||
(and (not view-mode)
|
||
(not (eq (get major-mode 'mode-class) 'special))
|
||
(view-mode-enter))))
|
||
|
||
;; FIXME: Why use a hook? Why pass it buffer-file-name?
|
||
(run-hook-with-args 'vc-mode-line-hook buffer-file-name)))))
|
||
|
||
(declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
|
||
|
||
(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 (string-prefix-p directory fname))
|
||
(with-current-buffer buffer
|
||
(vc-resynch-buffer fname keep noquery reset-vc-info))))))
|
||
|
||
(defun vc-resynch-buffer (file &optional keep noquery reset-vc-info)
|
||
"If FILE is currently visited, resynch its buffer."
|
||
(if (string= buffer-file-name
|
||
(if (file-name-absolute-p file)
|
||
file
|
||
(expand-file-name file (vc-root-dir))))
|
||
(vc-resynch-window file keep noquery reset-vc-info)
|
||
(if (file-directory-p file)
|
||
(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 reset-vc-info))))))
|
||
;; Try to avoid unnecessary work, a *vc-dir* buffer is only present
|
||
;; if this is true.
|
||
(when vc-dir-buffers
|
||
(vc-dir-resynch-file file)))
|
||
|
||
(defun vc-buffer-sync (&optional not-essential)
|
||
"Make sure the current buffer and its working file are in sync.
|
||
NOT-ESSENTIAL means it is okay to continue if the user says not to save."
|
||
(let (missing)
|
||
(when (cond
|
||
((buffer-modified-p))
|
||
((not (file-exists-p buffer-file-name))
|
||
(setq missing t)))
|
||
(if (or vc-suppress-confirm
|
||
(y-or-n-p (format "Buffer %s %s; save it? "
|
||
(buffer-name)
|
||
(if missing
|
||
"is missing on disk"
|
||
"modified"))))
|
||
(save-buffer)
|
||
(unless not-essential
|
||
(error "Aborted"))))))
|
||
|
||
;; Command closures
|
||
|
||
;; Set up key bindings for use while editing log messages
|
||
|
||
(declare-function log-edit-empty-buffer-p "log-edit" ())
|
||
(declare-function log-edit-diff-fileset "log-edit" ())
|
||
(declare-function log-edit-diff-patch "log-edit" ())
|
||
|
||
(defvar vc-patch-string)
|
||
|
||
(defun vc-log-edit (fileset mode backend &optional diff-function)
|
||
"Set up `log-edit' for use on FILE."
|
||
(setq default-directory
|
||
(buffer-local-value 'default-directory vc-parent-buffer))
|
||
(require 'log-edit)
|
||
(log-edit 'vc-finish-logentry
|
||
;; Setup a new log message if the log buffer is "empty",
|
||
;; or was previously used for a different set of files.
|
||
(or (log-edit-empty-buffer-p)
|
||
(and (local-variable-p 'vc-log-fileset)
|
||
(not (equal vc-log-fileset fileset))))
|
||
`((log-edit-listfun
|
||
. ,(lambda ()
|
||
;; FIXME: When fileset includes directories, and
|
||
;; there are relevant ChangeLog files inside their
|
||
;; children, we don't find them. Either handle it
|
||
;; in `log-edit-insert-changelog-entries' by
|
||
;; walking down the file trees, or somehow pass
|
||
;; `fileset-only-files' from `vc-next-action'
|
||
;; through to this function.
|
||
(let ((root (vc-root-dir)))
|
||
;; Returns paths relative to the root, so that
|
||
;; `log-edit-changelog-insert-entries'
|
||
;; substitutes them in correctly later, even when
|
||
;; `vc-checkin' was called from a file buffer, or
|
||
;; a non-root VC-Dir buffer.
|
||
(mapcar
|
||
(lambda (file) (file-relative-name file root))
|
||
fileset))))
|
||
(log-edit-diff-function
|
||
. ,(cond (diff-function)
|
||
(vc-patch-string #'log-edit-diff-patch)
|
||
(t #'log-edit-diff-fileset)))
|
||
(log-edit-vc-backend . ,backend)
|
||
(vc-log-fileset . ,fileset)
|
||
(vc-patch-string . ,vc-patch-string))
|
||
nil
|
||
mode)
|
||
(set-buffer-modified-p nil)
|
||
(setq buffer-file-name nil))
|
||
|
||
(defvar log-edit-hook)
|
||
|
||
(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook backend patch-string diff-function)
|
||
"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
|
||
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). 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'.
|
||
BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer.
|
||
PATCH-STRING is a patch to check in.
|
||
DIFF-FUNCTION is `log-edit-diff-function' for the Log Edit buffer."
|
||
(let ((parent (or (and (length= files 1)
|
||
(not (vc-dispatcher-browsing))
|
||
(get-file-buffer (car files)))
|
||
(current-buffer)))
|
||
(immediate (and comment (not initial-contents))))
|
||
(if (and comment (not initial-contents))
|
||
(set-buffer (get-buffer-create logbuf))
|
||
(pop-to-buffer (get-buffer-create logbuf)))
|
||
(setq-local vc-parent-buffer parent)
|
||
(setq-local vc-parent-buffer-name
|
||
(concat " from " (buffer-name vc-parent-buffer)))
|
||
(when patch-string
|
||
(setq-local vc-patch-string patch-string))
|
||
(let (;; `log-edit-hook' is usually for things like
|
||
;; `log-edit-show-files' and `log-edit-maybe-show-diff' which
|
||
;; don't make sense if the user is not going to do any
|
||
;; editing, and can cause unexpected window layout changes.
|
||
(log-edit-hook (and (not immediate)
|
||
(require 'log-edit) log-edit-hook)))
|
||
(vc-log-edit files mode backend diff-function))
|
||
(make-local-variable 'vc-log-after-operation-hook)
|
||
(when after-hook
|
||
(setq vc-log-after-operation-hook after-hook))
|
||
(setq-local vc-log-operation action)
|
||
(when comment
|
||
(erase-buffer)
|
||
(when (stringp comment) (insert comment)))
|
||
(if immediate
|
||
(vc-finish-logentry (eq comment t))
|
||
(message (substitute-command-keys
|
||
"%s Type \\<log-edit-mode-map>\\[log-edit-done] when done")
|
||
msg))))
|
||
|
||
(defvar log-edit-vc-backend)
|
||
(declare-function vc-buffer-sync-fileset "vc")
|
||
|
||
;; 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
|
||
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))
|
||
(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)
|
||
(log-fileset vc-log-fileset)
|
||
(log-entry (buffer-string))
|
||
(after-hook vc-log-after-operation-hook)
|
||
(parent vc-parent-buffer))
|
||
;; OK, do it to it
|
||
(let ((log-operation-ret
|
||
(with-current-buffer parent
|
||
(let ((vc--inhibit-async-window t))
|
||
(funcall log-operation log-fileset log-entry)))))
|
||
|
||
(pop-to-buffer parent)
|
||
(setq vc-log-operation nil)
|
||
|
||
;; 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)))
|
||
|
||
(when (eq (car-safe log-operation-ret) 'async)
|
||
(vc--display-async-command-buffer (process-buffer
|
||
(cadr log-operation-ret))))
|
||
|
||
;; Now make sure we see the expanded headers.
|
||
;; If the `vc-log-operation' started an async operation then we
|
||
;; need to delay running the hooks. It tells us whether it did
|
||
;; that with a special return value.
|
||
(cl-flet ((resynch-and-hooks ()
|
||
(when (buffer-live-p parent)
|
||
(with-current-buffer parent
|
||
(mapc (lambda (file) (vc-resynch-buffer file t t))
|
||
log-fileset)
|
||
(run-hooks after-hook 'vc-finish-logentry-hook)))))
|
||
(if (eq (car-safe log-operation-ret) 'async)
|
||
(vc-exec-after #'resynch-and-hooks nil (cadr log-operation-ret))
|
||
(resynch-and-hooks))))))
|
||
|
||
(defun vc-dispatcher-browsing ()
|
||
"Are we in a directory browser buffer?"
|
||
(or (derived-mode-p 'vc-dir-mode)
|
||
(derived-mode-p 'dired-mode)
|
||
(derived-mode-p 'diff-mode)
|
||
(derived-mode-p 'log-view-mode)))
|
||
|
||
(declare-function vc-dir-marked-files "vc-dir")
|
||
(declare-function dired-get-marked-files "dired")
|
||
|
||
(defun vc-dispatcher--explicit-marks-p ()
|
||
"Are any files in the directory browser explicitly marked?"
|
||
(or (and (derived-mode-p 'vc-dir-mode)
|
||
(vc-dir-marked-files))
|
||
(and (derived-mode-p 'dired-mode)
|
||
(length> (dired-get-marked-files nil nil nil t) 1))))
|
||
|
||
;; These are unused.
|
||
;; (defun vc-dispatcher-in-fileset-p (fileset)
|
||
;; (let ((member nil))
|
||
;; (while (and (not member) fileset)
|
||
;; (let ((elem (pop fileset)))
|
||
;; (if (if (file-directory-p elem)
|
||
;; (string-prefix-p elem buffer-file-name)
|
||
;; (eq (current-buffer) (get-file-buffer elem)))
|
||
;; (setq member t))))
|
||
;; member))
|
||
|
||
;; (defun vc-dispatcher-selection-set (&optional observer)
|
||
;; "Deduce a set of files to which to apply an operation. Return a cons
|
||
;; cell (SELECTION . FILESET), where SELECTION is what the user chose
|
||
;; and FILES is the flist with any directories replaced by the listed files
|
||
;; within them.
|
||
|
||
;; If we're in a directory display, the fileset is the list of marked files (if
|
||
;; there is one) else the file on the current line. If not in a directory
|
||
;; display, but the current buffer visits a file, the fileset is a singleton
|
||
;; containing that file. Otherwise, throw an error."
|
||
;; (let ((selection
|
||
;; (cond
|
||
;; ;; Browsing with vc-dir
|
||
;; ((vc-dispatcher-browsing)
|
||
;; ;; If no files are marked, temporarily mark current file
|
||
;; ;; and choose on that basis (so we get subordinate files)
|
||
;; (if (not (vc-dir-marked-files))
|
||
;; (prog2
|
||
;; (vc-dir-mark-file)
|
||
;; (cons (vc-dir-marked-files) (vc-dir-marked-only-files))
|
||
;; (vc-dir-unmark-all-files t))
|
||
;; (cons (vc-dir-marked-files) (vc-dir-marked-only-files))))
|
||
;; ;; Visiting an eligible file
|
||
;; ((buffer-file-name)
|
||
;; (cons (list buffer-file-name) (list buffer-file-name)))
|
||
;; ;; No eligible file -- if there's a parent buffer, deduce from there
|
||
;; ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
|
||
;; (with-current-buffer vc-parent-buffer
|
||
;; (vc-dispatcher-browsing))))
|
||
;; (with-current-buffer vc-parent-buffer
|
||
;; (vc-dispatcher-selection-set)))
|
||
;; ;; No good set here, throw error
|
||
;; (t (error "No fileset is available here")))))
|
||
;; ;; We assume, in order to avoid unpleasant surprises to the user,
|
||
;; ;; that a fileset is not in good shape to be handed to the user if the
|
||
;; ;; buffers visiting the fileset don't match the on-disk contents.
|
||
;; (unless observer
|
||
;; (save-some-buffers
|
||
;; nil (lambda () (vc-dispatcher-in-fileset-p (cdr selection)))))
|
||
;; selection))
|
||
|
||
(provide 'vc-dispatcher)
|
||
|
||
;;; vc-dispatcher.el ends here
|