;;; vc.el --- drive a version-control system from within Emacs
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;; Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; - vc-update/vc-merge should deal with VC systems that don't
;; update/merge on a file basis, but on a whole repository basis.
;;
-;; - vc-register should register multiple files at a time. The
-;; `register' backend function already supports that.
+;; - the backend sometimes knows when a file it opens has been marked
+;; by the VCS as having a "conflict". Find a way to pass this info -
+;; to VC so that it can turn on smerge-mode when opening such a
+;; file.
;;
;; - the *VC-log* buffer needs font-locking.
;;
;; - make it easier to write logs, maybe C-x 4 a should add to the log
;; buffer if there's one instead of the ChangeLog.
;;
+;; - make vc-state for all backends return 'unregistered instead of
+;; nil for unregistered files, then update vc-next-action.
+;;
+;; - add a generic mechanism for remembering the current branch names,
+;; display the branch name in the mode-line. Replace
+;; vc-cvs-sticky-tag with that.
+;;
+;; - vc-register should register a fileset at a time. The backends
+;; already support this, only the front-end needs to be change to
+;; handle multiple files at a time.
+;;
+;; - add a mechanism to for ignoring files.
+;;
;; - deal with push/pull operations.
;;
;; - decide if vc-status should replace vc-dired.
;;
-;; - vc-status should be made asynchronous.
-;;
;; - vc-status needs a menu, mouse bindings and some color bling.
+;;
+;; - vc-status needs to show missing files. It probably needs to have
+;; another state for those files. The user might want to restore
+;; them, or remove them from the VCS. C-x v v might also need
+;; adjustments.
+;;
+;; - "snapshots" should be renamed to "branches", and thoroughly reworked.
+;;
+;; - do not default to RCS anymore when the current directory is not
+;; controlled by any VCS and the user does C-x v v
+;;
;;; Code:
"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."
- (with-current-buffer (process-buffer p)
- (save-excursion
- (let ((buffer-undo-list t)
- (inhibit-read-only t))
- (goto-char (process-mark p))
- (insert s)
- (set-marker (process-mark p) (point))))))
+ (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 (&optional buf)
"Prepare BUF for executing a VC command and make it current.
(defvar vc-sentinel-movepoint) ;Dynamically scoped.
(defun vc-process-sentinel (p s)
- (let ((previous (process-get p 'vc-previous-sentinel)))
- (if previous (funcall previous p s))
- (with-current-buffer (process-buffer p)
- (let (vc-sentinel-movepoint)
- ;; Normally, we want async code such as sentinels to not move point.
- (save-excursion
- (goto-char (process-mark p))
- (let ((cmds (process-get p 'vc-sentinel-commands)))
- (process-put p 'vc-sentinel-commands nil)
- (dolist (cmd cmds)
- ;; Each sentinel may move point and the next one should be run
- ;; at that new point. We could get the same result by having
- ;; each sentinel read&set process-mark, but since `cmd' needs
- ;; to work both for async and sync processes, this would be
- ;; difficult to achieve.
- (vc-exec-after cmd))))
- ;; But sometimes the sentinels really want to move point.
- (if vc-sentinel-movepoint
- (let ((win (get-buffer-window (current-buffer) 0)))
- (if (not win)
- (goto-char vc-sentinel-movepoint)
- (with-selected-window win
- (goto-char vc-sentinel-movepoint)))))))))
+ (let ((previous (process-get p 'vc-previous-sentinel))
+ (buf (process-buffer p)))
+ ;; Impatient users sometime kill "slow" buffers; check liveness
+ ;; to avoid "error in process sentinel: Selecting deleted buffer".
+ (when (buffer-live-p buf)
+ (if previous (funcall previous p s))
+ (with-current-buffer buf
+ (setq mode-line-process
+ (let ((status (process-status p)))
+ ;; Leave mode-line uncluttered, normally.
+ ;; (Let known any weirdness in-form-ally. ;-) --ttn
+ (unless (eq 'exit status)
+ (format " (%s)" status))))
+ (let (vc-sentinel-movepoint)
+ ;; Normally, we want async code such as sentinels to not move point.
+ (save-excursion
+ (goto-char (process-mark p))
+ (let ((cmds (process-get p 'vc-sentinel-commands)))
+ (process-put p 'vc-sentinel-commands nil)
+ (dolist (cmd cmds)
+ ;; Each sentinel may move point and the next one should be run
+ ;; at that new point. We could get the same result by having
+ ;; each sentinel read&set process-mark, but since `cmd' needs
+ ;; to work both for async and sync processes, this would be
+ ;; difficult to achieve.
+ (vc-exec-after cmd))))
+ ;; But sometimes the sentinels really want to move point.
+ (if vc-sentinel-movepoint
+ (let ((win (get-buffer-window (current-buffer) 0)))
+ (if (not win)
+ (goto-char vc-sentinel-movepoint)
+ (with-selected-window win
+ (goto-char vc-sentinel-movepoint))))))))))
(defun vc-exec-after (code)
"Eval CODE when the current buffer's process is done.
(eval code))
;; If a process is running, add CODE to the sentinel
((eq (process-status proc) 'run)
+ (setq mode-line-process
+ ;; Deliberate overstatement, but power law respected.
+ ;; (The message is ephemeral, so we make it loud.) --ttn
+ (propertize " (incomplete/in progress)"
+ 'face (if (featurep 'compile)
+ ;; ttn's preferred loudness
+ 'compilation-warning
+ ;; suitably available fallback
+ font-lock-warning-face)
+ 'help-echo
+ "A VC command is in progress in this buffer"))
(let ((previous (process-sentinel proc)))
(unless (eq previous 'vc-process-sentinel)
(process-put proc 'vc-previous-sentinel previous))
revision)
;; Verify that the fileset is homogenous
(dolist (file (cdr files))
- (if (not (vc-compatible-state (vc-state file) state))
- (error "Fileset is in a mixed-up state"))
- (if (not (eq (vc-checkout-model file) model))
+ (unless (vc-compatible-state (vc-state file) state)
+ (error "Fileset is in a mixed-up state"))
+ (unless (eq (vc-checkout-model file) model)
(error "Fileset has mixed checkout models")))
;; Check for buffers in the fileset not matching the on-disk contents.
(dolist (file files)
(error "Aborted"))
;; Now, check if we have unsaved changes.
(vc-buffer-sync t)
- (if (buffer-modified-p)
- (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file))
- (error "Aborted")))))))
+ (when (buffer-modified-p)
+ (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file))
+ (error "Aborted")))))))
;; Do the right thing
(cond
;; Files aren't registered
- ((not state)
+ ((or (not state) ;; RCS uses nil for unregistered files.
+ (eq state 'unregistered)
+ (eq state 'ignored))
(mapc 'vc-register files))
;; Files are up-to-date, or need a merge and user specified a revision
((or (eq state 'up-to-date) (and verbose (eq state 'needs-patch)))
(let ((ready-for-commit files))
;; If files are edited but read-only, give user a chance to correct
(dolist (file files)
- (if (not (file-writable-p file))
- (progn
- ;; Make the file+buffer read-write.
- (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file))
- (error "Aborted"))
- (set-file-modes file (logior (file-modes file) 128))
- (let ((visited (get-file-buffer file)))
- (if visited
- (with-current-buffer visited
- (toggle-read-only -1)))))))
+ (unless (file-writable-p file)
+ ;; Make the file+buffer read-write.
+ (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file))
+ (error "Aborted"))
+ (set-file-modes file (logior (file-modes file) 128))
+ (let ((visited (get-file-buffer file)))
+ (when visited
+ (with-current-buffer visited
+ (toggle-read-only -1))))))
;; Allow user to revert files with no changes
(save-excursion
(dolist (file files)
(let ((visited (get-file-buffer file)))
;; For files with locking, if the file does not contain
;; any changes, just let go of the lock, i.e. revert.
- (if (and (not (eq model 'implicit))
- (vc-workfile-unchanged-p file)
- ;; If buffer is modified, that means the user just
- ;; said no to saving it; in that case, don't revert,
- ;; because the user might intend to save after
- ;; finishing the log entry and committing.
- (not (and visited (buffer-modified-p))))
- (progn
- (vc-revert-file file)
- (delete file ready-for-commit))))))
+ (when (and (not (eq model 'implicit))
+ (vc-workfile-unchanged-p file)
+ ;; If buffer is modified, that means the user just
+ ;; said no to saving it; in that case, don't revert,
+ ;; because the user might intend to save after
+ ;; finishing the log entry and committing.
+ (not (and visited (buffer-modified-p))))
+ (vc-revert-file file)
+ (delete file ready-for-commit)))))
;; Remaining files need to be committed
(if (not ready-for-commit)
(message "No files remain to be committed")
(setq revision (read-string "New revision or backend: "))
(let ((vsym (intern (upcase revision))))
(if (member vsym vc-handled-backends)
- (vc-transfer-file file vsym)
+ (dolist (file files) (vc-transfer-file file vsym))
(vc-checkin ready-for-commit revision))))))))
;; locked by somebody else (locking VCSes only)
((stringp state)
- (let ((revision
- (if verbose
- (read-string "Revision to steal: ")
- (vc-working-revision file))))
- (dolist (file files) (vc-steal-lock file revision state))))
+ ;; In the old days, we computed the revision once and used it on
+ ;; the single file. Then, for the 2007-2008 fileset rewrite, we
+ ;; computed the revision once (incorrectly, using a free var) and
+ ;; used it on all files. To fix the free var bug, we can either
+ ;; use `(car files)' or do what we do here: distribute the
+ ;; revision computation among `files'. Although this may be
+ ;; tedious for those backends where a "revision" is a trans-file
+ ;; concept, it is nonetheless correct for both those and (more
+ ;; importantly) for those where "revision" is a per-file concept.
+ ;; If the intersection of the former group and "locking VCSes" is
+ ;; non-empty [I vaguely doubt it --ttn], we can reinstate the
+ ;; pre-computation approach of yore.
+ (dolist (file files)
+ (vc-steal-lock
+ file (if verbose
+ (read-string (format "%s revision to steal: " file))
+ (vc-working-revision file))
+ state)))
;; needs-patch
((eq state 'needs-patch)
(dolist (file files)
"%s is not up-to-date. Get latest revision? "
(file-name-nondirectory file)))
(vc-checkout file (eq model 'implicit) t)
- (if (and (not (eq model 'implicit))
- (yes-or-no-p "Lock this revision? "))
- (vc-checkout file t)))))
+ (when (and (not (eq model 'implicit))
+ (yes-or-no-p "Lock this revision? "))
+ (vc-checkout file t)))))
;; needs-merge
((eq state 'needs-merge)
(dolist (file files)
- (if (yes-or-no-p (format
+ (when (yes-or-no-p (format
"%s is not up-to-date. Merge in changes now? "
(file-name-nondirectory file)))
- (vc-maybe-resolve-conflicts file (vc-call merge-news file)))))
+ (vc-maybe-resolve-conflicts file (vc-call merge-news file)))))
;; unlocked-changes
((eq state 'unlocked-changes)
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-operation-hook."
+for `vc-log-after-operation-hook'."
(let ((parent
(if (eq major-mode 'vc-dired-mode)
;; If we are called from VC dired, the parent buffer is
(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff))
(make-obsolete 'vc-diff-switches-list 'vc-switches "22.1")
-(defun vc-diff-sentinel (verbose rev1-name rev2-name)
+(defun vc-diff-finish (buffer-name verbose)
;; The empty sync output case has already been handled, so the only
- ;; possibility of an empty output is for an async process, in which case
- ;; it's important to insert the "diffs end here" message in the buffer
- ;; since the user may miss a message in the echo area.
- (when verbose
- (let ((inhibit-read-only t))
- (if (eq (buffer-size) 0)
- (insert "No differences found.\n")
- (insert (format "\n\nDiffs between %s and %s end here." rev1-name rev2-name)))))
- (goto-char (point-min))
- (shrink-window-if-larger-than-buffer))
+ ;; possibility of an empty output is for an async process.
+ (when (buffer-live-p buffer-name)
+ (with-current-buffer (get-buffer buffer-name)
+ (and verbose
+ (zerop (buffer-size))
+ (let ((inhibit-read-only t))
+ (insert "No differences found.\n")))
+ (goto-char (point-min))
+ (let ((window (get-buffer-window (current-buffer) t)))
+ (when window
+ (shrink-window-if-larger-than-buffer window))))))
(defvar vc-diff-added-files nil
"If non-nil, diff added files by comparing them to /dev/null.")
;; bindings are nicer for read only buffers. pcl-cvs does the
;; same thing.
(setq buffer-read-only t)
- (vc-exec-after `(vc-diff-sentinel ,verbose ,rev1-name ,rev2-name))
+ (vc-exec-after `(vc-diff-finish ,(buffer-name) ,verbose))
;; Display the buffer, but at the end because it can change point.
(pop-to-buffer (current-buffer))
;; In the async case, we return t even if there are no differences
(interactive "DDired under VC (directory): \nP")
(let ((vc-dired-switches (concat vc-dired-listing-switches
(if vc-dired-recurse "R" ""))))
- (if (eq (string-match tramp-file-name-regexp dir) 0)
- (error "Sorry, vc-directory does not work over Tramp"))
(if read-switches
(setq vc-dired-switches
(read-string "Dired listing switches: "
;; Must be in sync with vc-status-printer.
(forward-char 25))
+;;;###autoload
(defun vc-status (dir)
"Show the VC status for DIR."
(interactive "DVC status for directory: ")
(cd dir)
(vc-status-mode))
-(defvar vc-status-mode-map
+(defvar vc-status-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
;; Marking.
(put 'vc-status-mode 'mode-class 'special)
+(defun vc-update-vc-status-buffer (entries buffer)
+ (with-current-buffer buffer
+ (dolist (entry entries)
+ (ewoc-enter-last vc-status
+ (vc-status-create-fileinfo (cdr entry) (car entry))))
+ (ewoc-goto-node vc-status (ewoc-nth vc-status 0))))
+
(defun vc-status-refresh ()
"Refresh the contents of the VC status buffer."
(interactive)
;; This is not very efficient; ewoc could use a new function here.
(ewoc-filter vc-status (lambda (node) nil))
(let ((backend (vc-responsible-backend default-directory)))
- (dolist (entry (vc-call-backend backend 'dir-status default-directory))
- (ewoc-enter-last vc-status
- (vc-status-create-fileinfo (cdr entry) (car entry)))))
- (ewoc-goto-node vc-status (ewoc-nth vc-status 0)))
+ ;; Call the dir-status backend function. dir-status is supposed to
+ ;; be asynchronous. It should compute the results and call the
+ ;; function passed as a an arg to update the vc-status buffer with
+ ;; the results.
+ (vc-call-backend
+ backend 'dir-status default-directory
+ #'vc-update-vc-status-buffer (current-buffer))))
(defun vc-status-next-line (arg)
"Go to the next line.
(defun vc-status-marked-files ()
"Return the list of marked files"
- (mapcar
+ (mapcar
(lambda (elem)
(expand-file-name (vc-status-fileinfo->name elem)))
(ewoc-collect
- vc-status
+ vc-status
(lambda (crt) (vc-status-fileinfo->marked crt)))))
;;; End experimental code.
(if (buffer-modified-p (get-file-buffer file))
(error "Please kill or save all modified buffers before updating."))
(if (vc-up-to-date-p file)
- (vc-checkout file nil "")
+ (vc-checkout file nil t)
(if (eq (vc-checkout-model file) 'locking)
(if (eq (vc-state file) 'edited)
(error "%s"
;; it should find all relevant files relative to
;; the default-directory.
nil)))
- (dolist (file (or args (list default-directory)))
- (if (eq (string-match tramp-file-name-regexp file) 0)
- (error "Sorry, vc-update-change-log does not work over Tramp")))
(vc-call-backend (vc-responsible-backend default-directory)
'update-changelog args))
HCoop / bpt / emacs.git / blobdiff