;;; 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
;;
;; Features in the new version:
;; * Key commands (vc-next-action = C-x v v, vc-print-log = C-x v l, vc-revert
-;; = C-x v u, vc-rollback = C-x v c, vc-diff = C-x v =, vc-update = C-x v +)
+;; = C-x v u, vc-rollback = C-x v c, vc-diff = C-x v =, vc-update = C-x v +)
;; now operate on filesets rather than individual files.
;; * The fileset for a command is either (a) all marked files in VC-dired
;; mode, (b) the currently visited file if it's under version control,
;; or (c) the current directory if the visited buffer is not under
-;; version control and a wildcarding-enable flag has been set.
+;; version control and a wildcarding-enable flag has been set.
;;
-;; If you maintain a client of the mode or customize it in your .emacs,
-;; note that some backend functions which formerly took single file arguments
+;; If you maintain a client of the mode or customize it in your .emacs,
+;; note that some backend functions which formerly took single file arguments
;; now take a list of files. These include: register, checkin, print-log,
;; rollback, and diff.
;; 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
;; that return 'file have per-file revision numbering; backends
;; that return 'repository have per-repository revision numbering,
;; so a revision level implicitly identifies a changeset
-;;
+;;
;; STATE-QUERYING FUNCTIONS
;;
;; * registered (file)
;;
;; - 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)
;;
;; Return the working revision of FILE. This is the revision fetched
;; by the last checkout or upate, not necessarily the same thing as the
-;; head or tip revision. Should return "0" for a file added but not yet
+;; head or tip revision. Should return "0" for a file added but not yet
;; committed.
;;
;; - latest-on-branch-p (file)
;; - mode-line-string (file)
;;
;; If provided, this function should return the VC-specific mode
-;; line string for FILE. The returned string should have a
+;; line string for FILE. The returned string should have a
;; `help-echo' property which is the text to be displayed as a
;; tooltip when the mouse hovers over the VC entry on the mode-line.
;; The default implementation deals well with all states that
;;
;; * create-repo (backend)
;;
-;; Create an empty repository in the current directory and initialize
-;; it so VC mode can add files to it. For file-oriented systems, this
+;; Create an empty repository in the current directory and initialize
+;; it so VC mode can add files to it. For file-oriented systems, this
;; need do no more than create a subdirectory with the right name.
;;
;; * register (files &optional rev comment)
;; and an initial description of the file, COMMENT, may be specified,
;; but it is not guaranteed that the backend will do anything with this.
;; The implementation should pass the value of vc-register-switches
-;; to the backend command. (Note: in older versions of VC, this
+;; to the backend command. (Note: in older versions of VC, this
;; command took a single file argument and not a list.)
;;
;; - init-revision (file)
;; should become the new revision number (not all backends do
;; anything with it). COMMENT is used as a check-in comment. The
;; implementation should pass the value of vc-checkin-switches to
-;; the backend command. (Note: in older versions of VC, this
+;; the backend command. (Note: in older versions of VC, this
;; command took a single file argument and not a list.)
;;
;; * find-revision (file rev buffer)
;; 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)
;; differences found), or 1 (either non-empty diff or the diff is
;; run asynchronously).
;;
-;; - revision-completion-table (file)
+;; - revision-completion-table (files)
;;
-;; Return a completion table for existing revisions of FILE.
+;; Return a completion table for existing revisions of FILES.
;; The default is to not use any completion table.
;;
-;; - diff-tree (dir &optional rev1 rev2)
-;;
-;; Insert the diff for all files at and below DIR into the *vc-diff*
-;; buffer. The meaning of REV1 and REV2 is the same as for
-;; vc-BACKEND-diff. The default implementation does an explicit tree
-;; walk, calling vc-BACKEND-diff for each individual file.
-;;
;; - annotate-command (file buf &optional rev)
;;
;; If this function is provided, it should produce an annotated display
;; 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.")
`(let ((vc-touched-properties (list t)))
,form
(dolist (file ,files)
- (mapc (lambda (setting)
- (let ((property (car setting)))
- (unless (memq property vc-touched-properties)
- (put (intern file vc-file-prop-obarray)
- property (cdr setting)))))
- ,settings))))
+ (dolist (setting ,settings)
+ (let ((property (car setting)))
+ (unless (memq property vc-touched-properties)
+ (put (intern file vc-file-prop-obarray)
+ property (cdr setting))))))))
;; Two macros for elisp programming
Check in FILE with COMMENT (a string) after BODY has been executed.
FILE is passed through `expand-file-name'; BODY executed within
`save-excursion'. If FILE is not under version control, or you are
-using a locking version-control system and the file is locked by
+using a locking version-control system and the file is locked by
somebody else, signal error."
(declare (debug t) (indent 2))
(let ((filevar (make-symbol "file")))
"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))
OKSTATUS is nil, that means to ignore error status, if it is `async', that
means not to wait for termination of the subprocess; if it is t it means to
ignore all execution errors). 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
+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."
;; FIXME: file-relative-name can return a bogus result because
(mapcar (lambda (f) (file-relative-name (expand-file-name f)))
(if (listp file-or-list) file-or-list (list file-or-list))))
(full-command
- ;; What we're doing here is preparing a version of the command
+ ;; What we're doing here is preparing a version of the command
;; for display in a debug-progess message. If it's fewer than
- ;; 20 characters display the entire command (without trailing
+ ;; 20 characters display the entire command (without trailing
;; newline). Otherwise display the first 20 followed by an ellipsis.
(concat (if (string= (substring command -1) "\n")
(substring command 0 -1)
command)
- " "
- (vc-delistify (mapcar (lambda (s) (if (> (length s) 20) (concat (substring s 0 2) "...") s)) flags))
+ " "
+ (vc-delistify (mapcar (lambda (s) (if (> (length s) 20) (concat (substring s 0 2) "...") s)) flags))
" " (vc-delistify files))))
(save-current-buffer
(unless (or (eq buffer t)
(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)))
(shrink-window-if-larger-than-buffer)
(error "Running %s...FAILED (%s)" full-command
(if (integerp status) (format "status %d" status) status))))
- ;; We're done
- (if vc-command-messages
+ ;; We're done. But don't emit a status message if running
+ ;; asychronously, it would just mislead.
+ (if (and vc-command-messages (not (eq okstatus 'async)))
(message "Running %s...OK = %d" full-command status)))
(vc-exec-after
- `(run-hook-with-args 'vc-post-command-functions
+ `(run-hook-with-args 'vc-post-command-functions
',command ',file-or-list ',flags))
status))))
CONTEXT is that which `vc-buffer-context' returns."
(let ((point-context (nth 0 context))
(mark-context (nth 1 context))
- (reparse (nth 2 context)))
+ ;; (reparse (nth 2 context))
+ )
;; The new compilation code does not use compilation-error-list any
;; more, so the code below is now ineffective and might as well
;; be disabled. -- Stef
node (lambda (f) (if (vc-backend f) (push f flattened)))))
(nreverse flattened)))
-(defun vc-deduce-fileset (&optional allow-directory-wildcard)
- "Deduce a set of files and a backend to apply an operation to.
-
-If we're in VC-dired-mode, the fileset is the list of marked
-files. Otherwise, if we're looking at a buffer visiting a
-version-controlled file. the fileset is a singleton containing
-the relative filename, throw an error.
-
-If neither of these things is true, but allow-directory-wildcard is on,
-select all files under version control at and below the current
-directory.
-
-Otherwise, throw an error.
-"
- (cond (vc-dired-mode
- (let ((regexp (dired-marker-regexp))
- (marked (dired-map-over-marks (dired-get-filename) nil)))
+(defun vc-deduce-fileset (&optional allow-directory-wildcard allow-unregistered)
+ "Deduce a set of files and a backend to which to apply an operation.
+
+If we're in VC-dired mode, the fileset is the list of marked files.
+Otherwise, if we're looking at a buffer visiting a version-controlled file,
+the fileset is a singleton containing this file.
+If neither of these things is true, but ALLOW-DIRECTORY-WILDCARD is on
+and we're in a dired buffer, select the current directory.
+If none of these conditions is met, but ALLOW_UNREGISTERED is in and the
+visited file is not registered, return a singletin fileset containing it.
+Otherwise, throw an error."
+ (cond (vc-dired-mode
+ (let ((marked (dired-map-over-marks (dired-get-filename) nil)))
(unless marked
(error "No files have been selected."))
;; All members of the fileset must have the same backend
(let ((firstbackend (vc-backend (car marked))))
- (mapc (lambda (f) (unless (eq (vc-backend f) firstbackend)
- (error "All members of a fileset must be under the same version-control system.")))
- (cdr marked)))
+ (dolist (f (cdr marked))
+ (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 (buffer-file-name vc-parent-buffer))
+ ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
+ (with-current-buffer vc-parent-buffer
+ vc-dired-mode)))
(progn
(set-buffer vc-parent-buffer)
(vc-deduce-fileset)))
- ;; This is guarded by an enabling arg so users won't potentially
- ;; shoot themselves in the foot by modifying a fileset they can't
+ ;; This is guarded by an enabling arg so users won't potentially
+ ;; shoot themselves in the foot by modifying a fileset they can't
;; verify by eyeball. Allow it for nondestructive commands like
;; making diffs, or possibly for destructive ones that have
;; confirmation prompts.
- (allow-directory-wildcard
+ ((and allow-directory-wildcard
+ ;; I think this is a misfeature. For now, I'll leave it in, but
+ ;; I'll disable it anywhere else than in dired buffers. --Stef
+ (and (derived-mode-p 'dired-mode)
+ (equal buffer-file-name nil)
+ (equal list-buffers-directory default-directory)))
(progn
(message "All version-controlled files below %s selected."
default-directory)
(list default-directory)))
+ ((and allow-unregistered (not (vc-registered buffer-file-name)))
+ (list buffer-file-name))
(t (error "No fileset is available here."))))
(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
If the repository file is changed, you are asked if you want to
merge in the changes into your working copy."
(interactive "P")
- (let* ((files (vc-deduce-fileset))
- (backend (vc-backend (car files)))
+ (let* ((files (vc-deduce-fileset nil t))
(state (vc-state (car files)))
(model (vc-checkout-model (car files)))
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
+ (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)))
(setq revision (read-string "Branch, revision, or backend to move to: "))
(let ((vsym (intern-soft (upcase revision))))
(if (member vsym vc-handled-backends)
- (mapc (lambda (file) (vc-transfer-file file vsym)) files)
- (mapc (lambda (file)
- (vc-checkout file (eq model 'implicit) revision))))))
+ (dolist (file files) (vc-transfer-file file vsym))
+ (dolist (file files)
+ (vc-checkout file (eq model 'implicit) revision)))))
((not (eq model 'implicit))
;; check the files out
- (mapc (lambda (file) (vc-checkout file t)) files))
+ (dolist (file files) (vc-checkout file t)))
(t
- ;; do nothing
- (message "Fileset is up-to-date"))))
- ;; Files have local changes
- ((eq state 'edited)
+ ;; do nothing
+ (message "Fileset is up-to-date"))))
+ ;; Files have local changes
+ ((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
- (save-excursion
- (set-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
- (let ((revertlist '()))
- (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))
+ (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.
+ (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))))
- (progn
- (vc-revert-file file)
- (delete file ready-for-commit)))))))
+ (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))))
- (mapc (lambda (file) (vc-steal-lock file revision state) files))))
- ;; needs-patch
+ ;; 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)
(if (yes-or-no-p (format
"%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)
(dolist (file files)
- (if (not (equal buffer-file-name file))
+ (if (not (equal buffer-file-name file))
(find-file-other-window file))
(if (save-window-excursion
- (vc-diff-internal
- (vc-backend file) nil (list file)
- (vc-working-revision file) nil)
+ (vc-diff-internal nil (list file) (vc-working-revision file) nil)
(goto-char (point-min))
(let ((inhibit-read-only t))
(insert
(vc-call-backend backend 'create-repo))
;;;###autoload
-(defun vc-register (&optional set-revision comment)
- "Register the current file into a version control system.
+(defun vc-register (&optional fname set-revision comment)
+ "Register into a version control system.
+If FNAME is given register that file, otherwise register the current file.
With prefix argument SET-REVISION, allow user to specify initial revision
level. If COMMENT is present, use that as an initial comment.
register the file. If no backend declares itself responsible, the
first backend that could register the file is used."
(interactive "P")
- (unless buffer-file-name (error "No visited file"))
- (when (vc-backend buffer-file-name)
- (if (vc-registered buffer-file-name)
- (error "This file is already registered")
- (unless (y-or-n-p "Previous master file has vanished. Make a new one? ")
- (error "Aborted"))))
- ;; Watch out for new buffers of size 0: the corresponding file
- ;; does not exist yet, even though buffer-modified-p is nil.
- (if (and (not (buffer-modified-p))
- (zerop (buffer-size))
- (not (file-exists-p buffer-file-name)))
- (set-buffer-modified-p t))
- (vc-buffer-sync)
-
- (vc-start-entry (list buffer-file-name)
- (if set-revision
- (read-string (format "Initial revision level for %s: "
- (buffer-name)))
- (vc-call-backend (vc-responsible-backend buffer-file-name)
- 'init-revision))
- (or comment (not vc-initial-comment))
- nil
- "Enter initial comment."
- (lambda (files rev comment)
- (dolist (file files)
- (message "Registering %s... " file)
- (let ((backend (vc-responsible-backend file t)))
- (vc-file-clearprops file)
- (vc-call-backend backend 'register (list file) rev comment)
- (vc-file-setprop file 'vc-backend backend)
- (unless vc-make-backup-files
- (make-local-variable 'backup-inhibited)
- (setq backup-inhibited t)))
- (message "Registering %s... done" file)))))
+ (when (and (null fname) (null buffer-file-name)) (error "No visited file"))
+
+ (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)
+ (error "This file is already registered")
+ (unless (y-or-n-p "Previous master file has vanished. Make a new one? ")
+ (error "Aborted"))))
+ ;; Watch out for new buffers of size 0: the corresponding file
+ ;; does not exist yet, even though buffer-modified-p is nil.
+ (when bname
+ (with-current-buffer bname
+ (if (and (not (buffer-modified-p))
+ (zerop (buffer-size))
+ (not (file-exists-p buffer-file-name)))
+ (set-buffer-modified-p t))
+ (vc-buffer-sync)))
+ (vc-start-entry (list fname)
+ (if set-revision
+ (read-string (format "Initial revision level for %s: "
+ fname))
+ (vc-call-backend (vc-responsible-backend fname)
+ 'init-revision))
+ (or comment (not vc-initial-comment))
+ nil
+ "Enter initial comment."
+ (lambda (files rev comment)
+ (dolist (file files)
+ (message "Registering %s... " file)
+ (let ((backend (vc-responsible-backend file t)))
+ (vc-file-clearprops file)
+ (vc-call-backend backend 'register (list file) rev comment)
+ (vc-file-setprop file 'vc-backend backend)
+ (unless vc-make-backup-files
+ (make-local-variable 'backup-inhibited)
+ (setq backup-inhibited t)))
+ (message "Registering %s... done" file))))))
(defun vc-register-with (backend)
"Register the current file with a specified back end."
(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."
- (let ((parent
- (if (and files (equal (length files) 1))
- (get-file-buffer (car files))
- (current-buffer))))
- (if vc-before-checkin-hook
- (if files
- (with-current-buffer parent
- (run-hooks 'vc-before-checkin-hook))
- (run-hooks 'vc-before-checkin-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
+ ;; the current buffer.
+ (current-buffer)
+ (if (and files (equal (length files) 1))
+ (get-file-buffer (car files))
+ (current-buffer)))))
+ (when vc-before-checkin-hook
+ (if files
+ (with-current-buffer parent
+ (run-hooks 'vc-before-checkin-hook))
+ (run-hooks 'vc-before-checkin-hook)))
(if (and comment (not initial-contents))
(set-buffer (get-buffer-create "*VC-log*"))
(pop-to-buffer (get-buffer-create "*VC-log*")))
;;(if file (vc-mode-line file))
(vc-log-edit files)
(make-local-variable 'vc-log-after-operation-hook)
- (if after-hook
- (setq vc-log-after-operation-hook after-hook))
+ (when after-hook
+ (setq vc-log-after-operation-hook after-hook))
(setq vc-log-operation action)
(setq vc-log-revision rev)
(when comment
;; Check and record the comment, if any.
(unless nocomment
;; Comment too long?
- (vc-call-backend (or (and vc-log-fileset (vc-backend (car vc-log-fileset)))
+ (vc-call-backend (or (if vc-log-fileset (vc-backend vc-log-fileset))
(vc-responsible-backend default-directory))
'logentry-check)
(run-hooks 'vc-logentry-check-hook))
(pop-to-buffer tmp-vc-parent-buffer))))
;; Now make sure we see the expanded headers
(if log-fileset
- (mapc
- (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
+ (mapc
+ (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
log-fileset))
(if vc-dired-mode
(dired-move-to-filename))
;;; Additional entry points for examining version histories
-(defun vc-default-diff-tree (backend dir rev1 rev2)
- "List differences for all registered files at and below DIR.
-The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
- ;; This implementation does an explicit tree walk, and calls
- ;; vc-BACKEND-diff directly for each file. An optimization
- ;; would be to use `vc-diff-internal', so that diffs can be local,
- ;; and to call it only for files that are actually changed.
- ;; However, this is expensive for some backends, and so it is left
- ;; to backend-specific implementations.
- (setq default-directory dir)
- (vc-file-tree-walk
- default-directory
- (lambda (f)
- (vc-exec-after
- `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
- (message "Looking at %s" ',f)
- (vc-call-backend ',(vc-backend f)
- 'diff (list ',f) ',rev1 ',rev2))))))
+;; (defun vc-default-diff-tree (backend dir rev1 rev2)
+;; "List differences for all registered files at and below DIR.
+;; The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
+;; ;; This implementation does an explicit tree walk, and calls
+;; ;; vc-BACKEND-diff directly for each file. An optimization
+;; ;; would be to use `vc-diff-internal', so that diffs can be local,
+;; ;; and to call it only for files that are actually changed.
+;; ;; However, this is expensive for some backends, and so it is left
+;; ;; to backend-specific implementations.
+;; (setq default-directory dir)
+;; (vc-file-tree-walk
+;; default-directory
+;; (lambda (f)
+;; (vc-exec-after
+;; `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
+;; (message "Looking at %s" ',f)
+;; (vc-call-backend ',(vc-backend f)
+;; 'diff (list ',f) ',rev1 ',rev2))))))
(defun vc-coding-system-for-diff (file)
"Return the coding system for reading diff output for FILE."
(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))))))
-(defun vc-diff-internal (backend async files rev1 rev2 &optional verbose)
+(defvar vc-diff-added-files nil
+ "If non-nil, diff added files by comparing them to /dev/null.")
+
+(defun vc-diff-internal (async files rev1 rev2 &optional verbose)
"Report diffs between two revisions of a fileset.
Diff output goes to the *vc-diff* buffer. The function
returns t if the buffer had changes, nil otherwise."
;; Set coding system based on the first file. It's a kluge,
;; but the only way to set it for each file included would
;; be to call the back end separately for each file.
- (coding-system-for-read
+ (coding-system-for-read
(if files (vc-coding-system-for-diff (car files)) 'undecided)))
(vc-setup-buffer "*vc-diff*")
(message "Finding changes in %s..." filenames)
- ;; Many backends don't handle well the case of a file that has been
- ;; added but not yet committed to the repo (notably CVS and Subversion).
- ;; Do that work here so the backends don't have to futz with it.
- (let ((filtered '()))
- (dolist (file files)
- (cond ((and (not (file-directory-p file)) (string= (vc-working-revision file) "0"))
- (progn
- ;; This file is added but not yet committed;
- ;; there is no master file to diff against.
- (if (or rev1 rev2)
- (error "No revisions of %s exist" file)
- ;; We regard this as "changed".
- ;; Diff it against /dev/null.
- (apply 'vc-do-command "*vc-diff*"
- 1 "diff" file
- (append (vc-switches nil 'diff) '("/dev/null"))))))
- (t
- (add-to-list 'filtered file t))))
- (let ((vc-disable-async-diff (not async)))
- (vc-call-backend backend 'diff filtered rev1 rev2 "*vc-diff*")))
+ ;; Many backends don't handle well the case of a file that has been
+ ;; added but not yet committed to the repo (notably CVS and Subversion).
+ ;; Do that work here so the backends don't have to futz with it. --ESR
+ ;;
+ ;; Actually most backends (including CVS) have options to control the
+ ;; behavior since which one is better depends on the user and on the
+ ;; situation). Worse yet: this code does not handle the case where
+ ;; `file' is a directory which contains added files.
+ ;; I made it conditional on vc-diff-added-files but it should probably
+ ;; just be removed (or copied/moved to specific backends). --Stef.
+ (when vc-diff-added-files
+ (let ((filtered '()))
+ (dolist (file files)
+ (if (or (file-directory-p file)
+ (not (string= (vc-working-revision file) "0")))
+ (push file filtered)
+ ;; This file is added but not yet committed;
+ ;; there is no master file to diff against.
+ (if (or rev1 rev2)
+ (error "No revisions of %s exist" file)
+ ;; We regard this as "changed".
+ ;; Diff it against /dev/null.
+ (apply 'vc-do-command "*vc-diff*"
+ 1 "diff" file
+ (append (vc-switches nil 'diff) '("/dev/null"))))))
+ (setq files (nreverse filtered))))
+ (let ((vc-disable-async-diff (not async)))
+ (vc-call diff files rev1 rev2 "*vc-diff*"))
(set-buffer "*vc-diff*")
(if (and (zerop (buffer-size))
(not (get-buffer-process (current-buffer))))
(progn
(message "No changes between %s and %s" rev1-name rev2-name)
nil)
+ (diff-mode)
+ ;; Make the *vc-diff* buffer read only, the diff-mode key
+ ;; bindings are nicer for read only buffers. pcl-cvs does the
+ ;; same thing.
+ (setq buffer-read-only t)
+ (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))
- ;; Gnus-5.8.5 sets up an autoload for diff-mode, even if it's
- ;; not available. Work around that.
- (if (require 'diff-mode nil t) (diff-mode))
- (vc-exec-after `(vc-diff-sentinel ,verbose ,rev1-name ,rev2-name))
;; In the async case, we return t even if there are no differences
;; because we don't know that yet.
t)))
;;;###autoload
-(defun vc-history-diff (backend files rev1 rev2)
+(defun vc-version-diff (files rev1 rev2)
"Report diffs between revisions of the fileset in the repository history."
(interactive
(let* ((files (vc-deduce-fileset t))
(first (car files))
- (backend (vc-backend first))
(completion-table
- (vc-call-backend backend 'revision-completion-table first))
+ (vc-call revision-completion-table files))
(rev1-default nil)
(rev2-default nil))
(cond
(read-string rev2-prompt nil nil rev2-default))))
(if (string= rev1 "") (setq rev1 nil))
(if (string= rev2 "") (setq rev2 nil))
- (list backend files rev1 rev2))))
+ (list files rev1 rev2))))
(if (and (not rev1) rev2)
(error "Not a valid revision range."))
- (vc-diff-internal backend t files rev1 rev2 (interactive-p)))
+ (vc-diff-internal t files rev1 rev2 (interactive-p)))
-(defun vc-contains-version-controlled-file (dir)
- "Return t if DIR contains a version-controlled file, nil otherwise."
- (catch 'found
- (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 'found 't))) (directory-files dir))
- nil))
+;; (defun vc-contains-version-controlled-file (dir)
+;; "Return t if DIR contains a version-controlled file, nil otherwise."
+;; (catch 'found
+;; (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 'found 't))) (directory-files dir))
+;; nil))
;;;###autoload
-(defun vc-diff (historic)
+(defun vc-diff (historic &optional not-urgent)
"Display diffs between file revisions.
Normally this compares the currently selected fileset with their
-working revisions. With a prefix argument HISTORIC, it reads two revision
+working revisions. With a prefix argument HISTORIC, it reads two revision
designators specifying which revisions to compare.
If no current fileset is available (that is, we are not in
VC-Dired mode and the visited file of the current buffer is not
-under version control) behave specially; if there are
-version-controlled files in the current directory, treat all
-version-controlled files recursively beneath the current
-directory as the selected fileset.
-"
+under version control) and we're in a Dired buffer, use
+the current directory.
+The optional argument NOT-URGENT non-nil means it is ok to say no to
+saving the buffer."
+ (interactive (list current-prefix-arg t))
+ (if historic
+ (call-interactively 'vc-version-diff)
+ (let* ((files (vc-deduce-fileset t)))
+ (if buffer-file-name (vc-buffer-sync not-urgent))
+ (vc-diff-internal t files nil nil (interactive-p)))))
- (interactive "P")
- (cond
- ;;((not (vc-contains-version-controlled-file default-directory))
- ;;(error "No version-controlled files directly beneath default directory"))
- (historic
- (call-interactively 'vc-history-diff))
- (t
- (let* ((files (vc-deduce-fileset t))
- (first (car files))
- (backend
- (cond ((file-directory-p first)
- (vc-responsible-backend first))
- (t
- (vc-backend first)))))
- (vc-diff-internal backend t files nil nil (interactive-p))))))
;;;###autoload
(defun vc-revision-other-window (rev)
(with-current-buffer filebuf
(vc-call find-revision file revision outbuf))))
(setq failed nil))
- (if (and failed (file-exists-p filename))
- (delete-file filename))))
+ (when (and failed (file-exists-p filename))
+ (delete-file filename))))
(vc-mode-line file))
(message "Checking out %s...done" filename)))
- (find-file-noselect filename)))
+ (let ((result-buf (find-file-noselect filename)))
+ (with-current-buffer result-buf
+ ;; 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)))
;; Header-insertion code
(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.
(setq mode-name (concat mode-name backend-name))
;; Add menu after `vc-dired-mode-map' has `dired-mode-map' as the parent.
(let ((vc-dire-menu-map (copy-keymap vc-menu-map)))
- (define-key-after (lookup-key vc-dired-mode-map [menu-bar]) [vc]
+ (define-key-after (lookup-key vc-dired-mode-map [menu-bar]) [vc]
(cons backend-name vc-dire-menu-map) 'subdir)))
(setq vc-dired-mode t))
(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."
(let (result)
;; Check whether dired is loaded.
(when (fboundp 'dired-buffers-for-dir)
- (mapc (lambda (buffer)
- (with-current-buffer buffer
- (if vc-dired-mode
- (setq result (append result (list buffer))))))
- (dired-buffers-for-dir dir)))
- result))
+ (dolist (buffer (dired-buffers-for-dir dir))
+ (with-current-buffer buffer
+ (if vc-dired-mode
+ (push buffer result)))))
+ (nreverse result)))
(defun vc-dired-resynch-file (file)
"Update the entries for FILE in any VC Dired buffers that list it."
(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
If WORKING-REVISION is non-nil, leave the point at that revision."
(interactive)
(let* ((files (vc-deduce-fileset))
- (backend (vc-backend (car files)))
+ (backend (vc-backend files))
(working-revision (or working-revision (vc-working-revision (car files)))))
;; Don't switch to the output buffer before running the command,
;; so that any buffer-local settings in the vc-controlled
This asks for confirmation if the buffer contents are not identical
to the working revision (except for keyword expansion)."
(interactive)
- (let* ((files (vc-deduce-fileset))
- (backend (vc-backend (car files))))
+ (let* ((files (vc-deduce-fileset)))
;; If any of the files is visited by the current buffer, make
;; sure buffer is saved. If the user says `no', abort since
;; we cannot show the changes and ask for confirmation to
(if (or (not files) (memq (buffer-file-name) files))
(vc-buffer-sync nil))
(dolist (file files)
- (let (buf (get-file-buffer file))
+ (let ((buf (get-file-buffer file)))
(if (and buf (buffer-modified-p buf))
(error "Please kill or save all modified buffers before reverting.")))
(if (vc-up-to-date-p file)
(unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
(error "Revert canceled"))))
- (if (vc-diff-internal backend vc-allow-async-revert files nil nil)
+ (if (vc-diff-internal vc-allow-async-revert files nil nil)
(progn
(unless (yes-or-no-p (format "Discard changes in %s? " (vc-delistify files)))
(error "Revert canceled"))
depending on the underlying version-control system."
(interactive)
(let* ((files (vc-deduce-fileset))
- (backend (vc-backend (car files)))
+ (backend (vc-backend files))
(granularity (vc-call-backend backend 'revision-granularity)))
(unless (vc-find-backend-function backend 'rollback)
(error "Rollback is not supported in %s" backend))
(message "Finding changes...")
(let* ((tip (vc-working-revision (car files)))
(previous (vc-call previous-revision (car files) tip)))
- (vc-diff-internal backend nil files previous tip))
- ;; Display changes
+ (vc-diff-internal nil files previous tip))
+ ;; Display changes
(unless (yes-or-no-p "Discard these revisions? ")
(error "Rollback canceled"))
(delete-windows-on "*vc-diff*")
`((vc-state . ,'up-to-date)
(vc-checkout-time . , (nth 5 (file-attributes file)))
(vc-working-revision . nil)))
- (mapc (lambda (f) (vc-resynch-buffer f t t)) files)
+ (dolist (f files) (vc-resynch-buffer f t t))
(message "Rolling back %s...done" (vc-delistify files))))
;;;###autoload
;;;###autoload
(defun vc-update ()
"Update the current fileset's files to their tip revisions.
-For each one that contains no changes, and is not locked, then this simply
-replaces the work file with the latest revision on its branch. If the file
-contains changes, and the backend supports merging news, then any recent
+For each one that contains no changes, and is not locked, then this simply
+replaces the work file with the latest revision on its branch. If the file
+contains changes, and the backend supports merging news, then any recent
changes from the current branch are merged into the working file."
(interactive)
(dolist (file (vc-deduce-fileset))
(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
- (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.
If version backups should be used for FILE, and there exists
-such a backup for REV or the working revision of file, return
+such a backup for REV or the working revision of file, return
its name; otherwise return nil."
(when (vc-call make-version-backups-p file)
(let ((backup-file (vc-version-backup-file-name file rev)))
;; 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))
(defalias 'vc-rcs-update-changelog 'vc-update-changelog-rcs2log)
;; FIXME: This should probably be moved to vc-rcs.el and replaced in
;; vc-cvs.el by code using cvs2cl.
-(defun vc-update-changelog-rcs2log (backend files)
+(defun vc-update-changelog-rcs2log (files)
"Default implementation of update-changelog.
Uses `rcs2log' which only works for RCS and CVS."
;; FIXME: We (c|sh)ould add support for cvs2cl
((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
(vc-call-backend backend 'wash-log)
(buffer-string))))
-(defun vc-default-unregister (backend file)
- "Default implementation of `vc-unregister', signals an error."
- (error "Unregistering files is not supported for %s" backend))
-
(defun vc-default-receive-file (backend file rev)
"Let BACKEND receive FILE from another version control system."
(vc-call-backend backend 'register file rev ""))
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]
Customization variables:
`vc-annotate-menu-elements' customizes the menu elements of the
-mode-specific menu. `vc-annotate-color-map' and
-`vc-annotate-very-old-color' defines the mapping of time to
-colors. `vc-annotate-background' specifies the background color."
+mode-specific menu. `vc-annotate-color-map' and
+`vc-annotate-very-old-color' define the mapping of time to colors.
+`vc-annotate-background' specifies the background color."
(interactive
(save-current-buffer
(vc-ensure-vc-buffer)
;; of the user's cursor :-(
(when ,current-line ;(and (bobp))
(goto-line ,current-line)
- (setq vc-sentinel-movepoint))
+ (setq vc-sentinel-movepoint (point)))
(unless (active-minibuffer-window)
(message "Annotating... done")))))))
(if (not prev-rev)
(message "Cannot diff from any revision prior to %s" rev-at-line)
(save-window-excursion
- (vc-diff-internal
- (vc-backend vc-annotate-parent-file)
- nil
- (list vc-annotate-parent-file)
- prev-rev rev-at-line))
+ (vc-diff-internal nil (list vc-annotate-parent-file)
+ prev-rev rev-at-line))
(switch-to-buffer "*vc-diff*"))))))
(defun vc-annotate-warp-revision (revspec)
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