;;; 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 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>
;; Keywords: tools
-;; $Id$
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; to be installed somewhere on Emacs's path for executables.
;;
;; If your site uses the ChangeLog convention supported by Emacs, the
-;; function log-edit-comment-to-change-log could prove a useful checkin hook,
-;; although you might prefer to use C-c C-a (i.e. log-edit-insert-changelog)
+;; function `log-edit-comment-to-change-log' could prove a useful checkin hook,
+;; although you might prefer to use C-c C-a (i.e. `log-edit-insert-changelog')
;; from the commit buffer instead or to set `log-edit-setup-invert'.
;;
;; The vc code maintains some internal state in order to reduce expensive
;;
;; - dir-state (dir)
;;
-;; If provided, this function is used to find the version control state
-;; of all files in DIR in a fast way. The function should not return
-;; anything, but rather store the files' states into the corresponding
-;; `vc-state' properties.
+;; If provided, this function is used to find the version control
+;; state of as many files as possible in DIR, and all subdirectories
+;; of DIR, in a fast way; it is used to avoid expensive indivitual
+;; vc-state calls. The function should not return anything, but
+;; rather store the files' states into the corresponding properties.
+;; Two properties are required: `vc-backend' and `vc-state'. (Note:
+;; in older versions this method was not required to recurse into
+;; subdirectories.)
;;
;; * working-revision (file)
;;
;; used for files under this backend, and if files can indeed be
;; locked by other users.
;;
+;; - modify-change-comment (files rev comment)
+;;
+;; Modify the change comments associated with the files at the
+;; given revision. This is optional, many backends do not support it.
+;;
;; HISTORY FUNCTIONS
;;
;; * print-log (files &optional buffer)
;; to your backend and which does not map to any of the VC generic
;; concepts.
+;;; Todo:
+
+;; - Make vc-checkin avoid reverting the buffer if has not changed
+;; after the checkin. Comparing (md5 BUFFER) to (md5 FILE) should
+;; be enough.
+;;
+;; - vc-update/vc-merge should deal with VC systems that don't
+;; update/merge on a file basis, but on a whole repository basis.
+;;
+;; - 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 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:
(require 'vc-hooks)
:group 'vc
:version "20.3")
-(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn"
- ".git" ".hg" ".bzr" "{arch}")
- "List of directory names to be ignored when walking directory trees."
- :type '(repeat string)
- :group 'vc)
-
(defcustom vc-diff-switches nil
"A string or list of strings specifying switches for diff under VC.
When running diff under a given BACKEND, VC concatenates the values of
(define-key m "N" 'vc-annotate-next-revision)
(define-key m "P" 'vc-annotate-prev-revision)
(define-key m "W" 'vc-annotate-working-revision)
+ (define-key m "V" 'vc-annotate-toggle-annotation-visibility)
m)
"Local keymap used for VC-Annotate mode.")
"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-postprocess 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))
(string= (buffer-name) buffer))
(eq buffer (current-buffer)))
(vc-setup-buffer buffer))
+ ;; If there's some previous async process still running, just kill it.
+ (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.
+ (if oldproc (delete-process oldproc)))
(let ((squeezed (remq nil flags))
(inhibit-read-only t)
(status 0))
;; start-process does not support remote execution
(setq okstatus nil))
(if (eq okstatus 'async)
- ;; Run asynchronously
+ ;; Run asynchronously.
(let ((proc
(let ((process-connection-type nil))
- (apply 'start-process command (current-buffer) command
- squeezed))))
+ (apply 'start-file-process command (current-buffer)
+ command squeezed))))
(if vc-command-messages
(message "Running %s in background..." full-command))
;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
(unless (eq (vc-backend f) firstbackend)
(error "All members of a fileset must be under the same version-control system."))))
marked))
- ((vc-backend buffer-file-name)
+ ((eq major-mode 'vc-status-mode)
+ (let ((marked (vc-status-marked-files)))
+ (if marked
+ marked
+ (list (vc-status-current-file)))))
+ ((vc-backend buffer-file-name)
(list buffer-file-name))
((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
(with-current-buffer vc-parent-buffer
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
- (if vc-dired-mode
- (set-buffer (find-file-noselect (dired-get-filename)))
- (while vc-parent-buffer
+ (cond
+ (vc-dired-mode
+ (set-buffer (find-file-noselect (dired-get-filename))))
+ ((eq major-mode 'vc-status-mode)
+ (set-buffer (find-file-noselect (vc-status-current-file))))
+ (t
+ (while (and vc-parent-buffer
+ (buffer-live-p vc-parent-buffer)
+ ;; Avoid infinite looping when vc-parent-buffer and
+ ;; current buffer are the same buffer.
+ (not (eq vc-parent-buffer (current-buffer))))
(set-buffer vc-parent-buffer))
(if (not buffer-file-name)
(error "Buffer %s is not associated with a file" (buffer-name))
(if (not (vc-backend buffer-file-name))
- (error "File %s is not under version control" buffer-file-name)))))
+ (error "File %s is not under version control" buffer-file-name))))))
;;; Support for the C-x v v command. This is where all the single-file-oriented
;;; code from before the fileset rewrite lives.
(defvar vc-dired-window-configuration)
+(defun vc-compatible-state (p q)
+ "Controls which states can be in the same commit."
+ (or
+ (eq p q)
+ (and (member p '(edited added removed)) (member q '(edited added removed)))))
+
;; Here's the major entry point.
;;;###autoload
revision)
;; Verify that the fileset is homogenous
(dolist (file (cdr files))
- (if (not (eq (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)))
;; do nothing
(message "Fileset is up-to-date"))))
;; Files have local changes
- ((eq state 'edited)
+ ((vc-compatible-state state 'edited)
(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)
(interactive "P")
(when (and (null fname) (null buffer-file-name)) (error "No visited file"))
- (let ((bname (if fname (get-file-buffer fname) buffer-file-name)))
+ (let ((bname (if fname (get-file-buffer fname) (current-buffer))))
(unless fname (setq fname buffer-file-name))
(when (vc-backend fname)
(if (vc-registered fname)
(let ((vc-handled-backends (list backend)))
(call-interactively 'vc-register)))
+(declare-function view-mode-exit "view" (&optional return-to-alist exit-action all-win))
+
(defun vc-resynch-window (file &optional keep noquery)
"If FILE is in the current buffer, either revert or unvisit it.
The choice between revert (to see expanded keywords) and unvisit depends on
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
(message "Checking out %s...done" filename)))
(let ((result-buf (find-file-noselect filename)))
(with-current-buffer result-buf
- ;; Set the parent buffer so that things like
+ ;; Set the parent buffer so that things like
;; C-x v g, C-x v l, ... etc work.
(setq vc-parent-buffer filebuf))
result-buf)))
(vc-call-backend backend 'clear-headers)
(kill-buffer filename)))))
+(defun vc-modify-change-comment (files rev oldcomment)
+ "Edit the comment associated with the given files and revision."
+ (vc-start-entry
+ files rev oldcomment t
+ "Enter a replacement change comment."
+ (lambda (files rev comment)
+ (vc-call-backend
+ ;; Less of a kluge than it looks like; log-view mode only passes
+ ;; this function a singleton list. Arguments left in this form in
+ ;; case the more general operation ever becomes meaningful.
+ (vc-responsible-backend (car files))
+ 'modify-change-comment files rev comment))))
+
;;;###autoload
(defun vc-merge ()
"Merge changes between two revisions into the current buffer's file.
(replace-match (substring (concat vc-info " ") 0 10)
t t nil 1)))
+(defun vc-dired-ignorable-p (filename)
+ "Should FILENAME be ignored in VC-Dired listings?"
+ (catch t
+ ;; Ignore anything that wouldn't be found by completion (.o, .la, etc.)
+ (dolist (ignorable completion-ignored-extensions)
+ (let ((ext (substring filename
+ (- (length filename)
+ (length ignorable)))))
+ (if (string= ignorable ext) (throw t t))))
+ ;; Ignore Makefiles derived from something else
+ (when (string= (file-name-nondirectory filename) "Makefile")
+ (let* ((dir (file-name-directory filename))
+ (peers (directory-files (or dir default-directory))))
+ (if (or (member "Makefile.in" peers) (member "Makefile.am" peers))
+ (throw t t))))
+ nil))
+
(defun vc-dired-hook ()
"Reformat the listing according to version control.
Called by dired after any portion of a vc-dired buffer has been read in."
(message "Getting version information... ")
- (let (subdir filename (inhibit-read-only t))
+ ;; if the backend supports it, get the state
+ ;; of all files in this directory at once
+ (let ((backend (vc-responsible-backend default-directory)))
+ ;; check `backend' can really handle `default-directory'.
+ (if (and (vc-call-backend backend 'responsible-p default-directory)
+ (vc-find-backend-function backend 'dir-state))
+ (vc-call-backend backend 'dir-state default-directory)))
+ (let (filename
+ (inhibit-read-only t)
+ (buffer-undo-list t))
(goto-char (point-min))
(while (not (eobp))
(cond
;; subdir header line
- ((setq subdir (dired-get-subdir))
- ;; if the backend supports it, get the state
- ;; of all files in this directory at once
- (let ((backend (vc-responsible-backend subdir)))
- ;; check `backend' can really handle `subdir'.
- (if (and (vc-call-backend backend 'responsible-p subdir)
- (vc-find-backend-function backend 'dir-state))
- (vc-call-backend backend 'dir-state subdir)))
+ ((dired-get-subdir)
(forward-line 1)
;; erase (but don't remove) the "total" line
(delete-region (point) (line-end-position))
(t
(vc-dired-reformat-line nil)
(forward-line 1))))
- ;; ordinary file
- ((and (vc-backend filename)
- (not (and vc-dired-terse-mode
- (vc-up-to-date-p filename))))
- (vc-dired-reformat-line (vc-call dired-state-info filename))
- (forward-line 1))
- (t
- (dired-kill-line))))
+ ;; Try to head off calling the expensive state query -
+ ;; ignore object files, TeX intermediate files, and so forth.
+ ((vc-dired-ignorable-p filename)
+ (dired-kill-line))
+ ;; Ordinary file -- call the (possibly expensive) state query
+ ;;
+ ;; First case: unregistered or unknown. (Unknown shouldn't happen here)
+ ((member (vc-state filename) '(nil unregistered))
+ (if vc-dired-terse-mode
+ (dired-kill-line)
+ (vc-dired-reformat-line "?")
+ (forward-line 1)))
+ ;; Either we're in non-terse mode or it's out of date
+ ((not (and vc-dired-terse-mode (vc-up-to-date-p filename)))
+ (vc-dired-reformat-line (vc-call dired-state-info filename))
+ (forward-line 1))
+ ;; Remaining cases are under version control but uninteresting
+ (t
+ (dired-kill-line))))
;; any other line
(t (forward-line 1))))
(vc-dired-purge))
(widen)
(cond ((eq (count-lines (point-min) (point-max)) 1)
(goto-char (point-min))
- (message "No files locked under %s" default-directory)))))
+ (message "No changes pending under %s" default-directory)))))
(defun vc-dired-purge ()
"Remove empty subdirs."
(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: "
vc-dired-switches
'vc-dired-mode))))
+;;; Experimental code for the vc-dired replacement
+(require 'ewoc)
+
+(defstruct (vc-status-fileinfo
+ (:copier nil)
+ (:constructor vc-status-create-fileinfo (state name &optional marked))
+ (:conc-name vc-status-fileinfo->))
+ marked
+ state
+ name)
+
+(defvar vc-status nil)
+
+(defun vc-status-headers (backend dir)
+ (concat
+ (format "VC backend : %s\n" backend)
+ "Repository : The repository goes here\n"
+ (format "Working dir: %s\n" dir)))
+
+(defun vc-status-printer (fileentry)
+ "Pretty print FILEENTRY."
+ (insert
+ ;; If you change this, change vc-status-move-to-goal-column.
+ (format "%c %-20s %s"
+ (if (vc-status-fileinfo->marked fileentry) ?* ? )
+ (vc-status-fileinfo->state fileentry)
+ (vc-status-fileinfo->name fileentry))))
+
+(defun vc-status-move-to-goal-column ()
+ (beginning-of-line)
+ ;; 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: ")
+ (vc-setup-buffer "*vc-status*")
+ (switch-to-buffer "*vc-status*")
+ (cd dir)
+ (vc-status-mode))
+
+(defvar vc-status-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ ;; Marking.
+ (define-key map "m" 'vc-status-mark-file)
+ (define-key map "M" 'vc-status-mark-all-files)
+ (define-key map "u" 'vc-status-unmark-file)
+ (define-key map "\C-?" 'vc-status-unmark-file-up)
+ (define-key map "\M-\C-?" 'vc-status-unmark-all-files)
+ ;; Movement.
+ (define-key map "n" 'vc-status-next-line)
+ (define-key map " " 'vc-status-next-line)
+ (define-key map "\t" 'vc-status-next-line)
+ (define-key map "p" 'vc-status-previous-line)
+ (define-key map [backtab] 'vc-status-previous-line)
+ ;; VC commands.
+ (define-key map "=" 'vc-diff)
+ (define-key map "a" 'vc-status-register)
+ ;; Can't be "g" (as in vc map), so "A" for "Annotate".
+ (define-key map "A" 'vc-annotate)
+ ;; vc-print-log uses the current buffer, not a file.
+ ;; (define-key map "l" 'vc-status-print-log)
+ ;; The remainder.
+ (define-key map "f" 'vc-status-find-file)
+ (define-key map "o" 'vc-status-find-file-other-window)
+ (define-key map "q" 'bury-buffer)
+ (define-key map "g" 'vc-status-refresh)
+ map)
+ "Keymap for VC status")
+
+(defun vc-status-mode ()
+ "Major mode for VC status.
+\\{vc-status-mode-map}"
+ (setq mode-name "*VC Status*")
+ (setq major-mode 'vc-status-mode)
+ (setq buffer-read-only t)
+ (use-local-map vc-status-mode-map)
+ (let ((buffer-read-only nil)
+ (backend (vc-responsible-backend default-directory))
+ entries)
+ (erase-buffer)
+ (set (make-local-variable 'vc-status)
+ (ewoc-create #'vc-status-printer
+ (vc-status-headers backend default-directory)))
+ (vc-status-refresh)))
+
+(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)))
+ ;; 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.
+If a prefix argument is given, move by that many lines."
+ (interactive "p")
+ (ewoc-goto-next vc-status arg)
+ (vc-status-move-to-goal-column))
+
+(defun vc-status-previous-line (arg)
+ "Go to the previous line.
+If a prefix argument is given, move by that many lines."
+ (interactive "p")
+ (ewoc-goto-prev vc-status arg)
+ (vc-status-move-to-goal-column))
+
+(defun vc-status-mark-file ()
+ "Mark the current file and move to the next line."
+ (interactive)
+ (let* ((crt (ewoc-locate vc-status))
+ (file (ewoc-data crt)))
+ (setf (vc-status-fileinfo->marked file) t)
+ (ewoc-invalidate vc-status crt)
+ (vc-status-next-line 1)))
+
+(defun vc-status-mark-all-files ()
+ "Mark all files."
+ (interactive)
+ (ewoc-map
+ (lambda (file)
+ (unless (vc-status-fileinfo->marked file)
+ (setf (vc-status-fileinfo->marked file) t)
+ t))
+ vc-status))
+
+(defun vc-status-unmark-file ()
+ "Unmark the current file and move to the next line."
+ (interactive)
+ (let* ((crt (ewoc-locate vc-status))
+ (file (ewoc-data crt)))
+ (setf (vc-status-fileinfo->marked file) nil)
+ (ewoc-invalidate vc-status crt)
+ (vc-status-next-line 1)))
+
+(defun vc-status-unmark-file-up ()
+ "Move to the previous line and unmark the file."
+ (interactive)
+ ;; If we're on the first line, we won't move up, but we will still
+ ;; remove the mark. This seems a bit odd but it is what buffer-menu
+ ;; does.
+ (let* ((prev (ewoc-goto-prev vc-status 1))
+ (file (ewoc-data prev)))
+ (setf (vc-status-fileinfo->marked file) nil)
+ (ewoc-invalidate vc-status prev)
+ (vc-status-move-to-goal-column)))
+
+(defun vc-status-unmark-all-files ()
+ "Unmark all files."
+ (interactive)
+ (ewoc-map
+ (lambda (file)
+ (when (vc-status-fileinfo->marked file)
+ (setf (vc-status-fileinfo->marked file) nil)
+ t))
+ vc-status))
+
+(defun vc-status-register ()
+ "Register the marked files, or the current file if no marks."
+ (interactive)
+ (let ((files (or (vc-status-marked-files)
+ (list (vc-status-current-file)))))
+ (dolist (file files)
+ (vc-register file))))
+
+(defun vc-status-find-file ()
+ "Find the file on the current line."
+ (interactive)
+ (find-file (vc-status-current-file)))
+
+(defun vc-status-find-file-other-window ()
+ "Find the file on the current line, in another window."
+ (interactive)
+ (find-file-other-window (vc-status-current-file)))
+
+(defun vc-status-current-file ()
+ (let ((node (ewoc-locate vc-status)))
+ (unless node
+ (error "No file available."))
+ (expand-file-name (vc-status-fileinfo->name (ewoc-data node)))))
+
+(defun vc-status-marked-files ()
+ "Return the list of marked files"
+ (mapcar
+ (lambda (elem)
+ (expand-file-name (vc-status-fileinfo->name elem)))
+ (ewoc-collect
+ vc-status
+ (lambda (crt) (vc-status-fileinfo->marked crt)))))
+
+;;; End experimental code.
;; Named-configuration entry points
(vc-checkout file nil "")
(if (eq (vc-checkout-model file) 'locking)
(if (eq (vc-state file) 'edited)
- (error
- (substitute-command-keys
- "File is locked--type \\[vc-revert] to discard changes"))
- (error
- (substitute-command-keys
- "Unexpected file state (%s)--type \\[vc-next-action] to correct")
- (vc-state file)))
+ (error "%s"
+ (substitute-command-keys
+ "File is locked--type \\[vc-revert] to discard changes"))
+ (error "Unexpected file state (%s) -- type %s"
+ (vc-state file)
+ (substitute-command-keys
+ "\\[vc-next-action] to correct")))
(if (not (vc-find-backend-function (vc-backend file) 'merge-news))
(error "Sorry, merging news is not implemented for %s"
(vc-backend file))
- (vc-call merge-news file)
- (vc-resynch-buffer file t t))))))
+ (vc-maybe-resolve-conflicts file (vc-call merge-news file)))))))
(defun vc-version-backup-file (file &optional rev)
"Return name of backup file for revision REV of FILE.
;; 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))
((eq state 'edited) (concat "(" (vc-user-login-name file) ")"))
((eq state 'needs-merge) "(merge)")
((eq state 'needs-patch) "(patch)")
- ((eq state 'unlocked-changes) "(stale)")))
+ ((eq state 'added) "(added)")
+ ((eq state 'removed) "(removed)")
+ ((eq state 'ignored) "(ignored)") ;; dired-hook filters this out
+ ((eq state 'unregistered) "?")
+ ((eq state 'unlocked-changes) "(stale)")
+ ((not state) "(unknown)")))
(buffer
(get-file-buffer file))
(modflag
You can use the mode-specific menu to alter the time-span of the used
colors. See variable `vc-annotate-menu-elements' for customizing the
menu items."
+ ;; Frob buffer-invisibility-spec so that if it is originally a naked t,
+ ;; it will become a list, to avoid initial annotations being invisible.
+ (add-to-invisibility-spec 'foo)
+ (remove-from-invisibility-spec 'foo)
(set (make-local-variable 'truncate-lines) t)
(set (make-local-variable 'font-lock-defaults)
'(vc-annotate-font-lock-keywords t))
(view-mode 1))
+(defun vc-annotate-toggle-annotation-visibility ()
+ "Toggle whether or not the annotation is visible."
+ (interactive)
+ (funcall (if (memq 'vc-annotate-annotation buffer-invisibility-spec)
+ 'remove-from-invisibility-spec
+ 'add-to-invisibility-spec)
+ 'vc-annotate-annotation)
+ (force-window-update (current-buffer)))
+
(defun vc-annotate-display-default (ratio)
"Display the output of \\[vc-annotate] using the default color range.
The color range is given by `vc-annotate-color-map', scaled by RATIO.
;; Since entries should be sorted, we can just use the last one.
(caar (last color-map)))
+(defun vc-annotate-get-time-set-line-props ()
+ (let ((bol (point))
+ (date (vc-call-backend vc-annotate-backend 'annotate-time))
+ (inhibit-read-only t))
+ (assert (>= (point) bol))
+ (put-text-property bol (point) 'invisible 'vc-annotate-annotation)
+ date))
+
(defun vc-annotate-display-autoscale (&optional full)
"Highlight the output of \\[vc-annotate] using an autoscaled color map.
Autoscaling means that the map is scaled from the current time to the
(save-excursion
(goto-char (point-min))
(while (not (eobp))
- (when (setq date (vc-call-backend vc-annotate-backend 'annotate-time))
+ (when (setq date (vc-annotate-get-time-set-line-props))
(if (> date newest)
(setq newest date))
(if (< date oldest)
:style toggle :selected
(eq vc-annotate-display-mode 'fullscale)]
"--"
+ ["Toggle annotation visibility" vc-annotate-toggle-annotation-visibility]
["Annotate previous revision" vc-annotate-prev-revision]
["Annotate next revision" vc-annotate-next-revision]
["Annotate revision at line" vc-annotate-revision-at-line]
This calls the backend function annotate-time, and returns the
difference in days between the time returned and the current time,
or OFFSET if present."
- (let ((next-time (vc-call-backend vc-annotate-backend 'annotate-time)))
+ (let ((next-time (vc-annotate-get-time-set-line-props)))
(if next-time
(- (or offset
(vc-call-backend vc-annotate-backend 'annotate-current-time))
"Set up `log-edit' for use with VC on FILE."
(setq default-directory
(with-current-buffer vc-parent-buffer default-directory))
- (log-edit 'vc-finish-logentry nil `(lambda () ',fileset))
+ (log-edit 'vc-finish-logentry
+ nil
+ `((log-edit-listfun . (lambda () ',fileset))
+ (log-edit-diff-function . (lambda () (vc-diff nil)))))
(set (make-local-variable 'vc-log-fileset) fileset)
(make-local-variable 'vc-log-revision)
(set-buffer-modified-p nil)
HCoop / bpt / emacs.git / blobdiff