;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
-;; $Id$
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
when visiting a file managed by that backend.
An empty list disables VC altogether."
:type '(repeat symbol)
- :version "22.2"
+ :version "23.1"
+ :group 'vc)
+
+;; Note: we don't actually have a darcs back end yet.
+(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS"
+ ".svn" ".git" ".hg" ".bzr"
+ "_MTN" "_darcs" "{arch}")
+ "List of directory names to be ignored when walking directory trees."
+ :type '(repeat string)
:group 'vc)
(defcustom vc-path
(if (file-directory-p "/usr/sccs")
'("/usr/sccs")
nil)
- "*List of extra directories to search for version control commands."
+ "List of extra directories to search for version control commands."
:type '(repeat directory)
:group 'vc)
(defcustom vc-make-backup-files nil
- "*If non-nil, backups of registered files are made as with other files.
+ "If non-nil, backups of registered files are made as with other files.
If nil (the default), files covered by version control don't get backups."
:type 'boolean
:group 'vc
:group 'backup)
(defcustom vc-follow-symlinks 'ask
- "*What to do if visiting a symbolic link to a file under version control.
+ "What to do if visiting a symbolic link to a file under version control.
Editing such a file through the link bypasses the version control system,
which is dangerous and probably not what you want.
:group 'vc)
(defcustom vc-display-status t
- "*If non-nil, display revision number and lock status in modeline.
+ "If non-nil, display revision number and lock status in modeline.
Otherwise, not displayed."
:type 'boolean
:group 'vc)
(defcustom vc-consult-headers t
- "*If non-nil, identify work files by searching for version headers."
+ "If non-nil, identify work files by searching for version headers."
:type 'boolean
:group 'vc)
(defcustom vc-keep-workfiles t
- "*If non-nil, don't delete working files after registering changes.
+ "If non-nil, don't delete working files after registering changes.
If the back-end is CVS, workfiles are always kept, regardless of the
value of this flag."
:type 'boolean
:group 'vc)
(defcustom vc-mistrust-permissions nil
- "*If non-nil, don't assume permissions/ownership track version-control status.
+ "If non-nil, don't assume permissions/ownership track version-control status.
If nil, do rely on the permissions.
See also variable `vc-consult-headers'."
:type 'boolean
(vc-backend-subdirectory-name file)))))
(defcustom vc-stay-local t
- "*Non-nil means use local operations when possible for remote repositories.
+ "Non-nil means use local operations when possible for remote repositories.
This avoids slow queries over the network and instead uses heuristics
and past information to determine the current status of a file.
(defun vc-stay-local-p (file)
"Return non-nil if VC should stay local when handling FILE.
-This uses the `repository-hostname' backend operation."
- (let* ((backend (vc-backend file))
- (sym (vc-make-backend-sym backend 'stay-local))
- (stay-local (if (boundp sym) (symbol-value sym) t)))
- (if (eq stay-local t) (setq stay-local vc-stay-local))
- (if (symbolp stay-local) stay-local
- (let ((dirname (if (file-directory-p file)
- (directory-file-name file)
- (file-name-directory file))))
- (eq 'yes
- (or (vc-file-getprop dirname 'vc-stay-local-p)
- (vc-file-setprop
- dirname 'vc-stay-local-p
- (let ((hostname (vc-call-backend
- backend 'repository-hostname dirname)))
- (if (not hostname)
- 'no
- (let ((default t))
- (if (eq (car-safe stay-local) 'except)
- (setq default nil stay-local (cdr stay-local)))
- (when (consp stay-local)
- (setq stay-local
- (mapconcat 'identity stay-local "\\|")))
- (if (if (string-match stay-local hostname)
- default (not default))
- 'yes 'no)))))))))))
+This uses the `repository-hostname' backend operation.
+If FILE is a list of files, return non-nil if any of them
+individually should stay local."
+ (if (listp file)
+ (delq nil (mapcar 'vc-stay-local-p file))
+ (let* ((backend (vc-backend file))
+ (sym (vc-make-backend-sym backend 'stay-local))
+ (stay-local (if (boundp sym) (symbol-value sym) t)))
+ (if (eq stay-local t) (setq stay-local vc-stay-local))
+ (if (symbolp stay-local) stay-local
+ (let ((dirname (if (file-directory-p file)
+ (directory-file-name file)
+ (file-name-directory file))))
+ (eq 'yes
+ (or (vc-file-getprop dirname 'vc-stay-local-p)
+ (vc-file-setprop
+ dirname 'vc-stay-local-p
+ (let ((hostname (vc-call-backend
+ backend 'repository-hostname dirname)))
+ (if (not hostname)
+ 'no
+ (let ((default t))
+ (if (eq (car-safe stay-local) 'except)
+ (setq default nil stay-local (cdr stay-local)))
+ (when (consp stay-local)
+ (setq stay-local
+ (mapconcat 'identity stay-local "\\|")))
+ (if (if (string-match stay-local hostname)
+ default (not default))
+ 'yes 'no))))))))))))
;;; This is handled specially now.
;; Tell Emacs about this new kind of minor mode
(t (apply f args)))))
(defmacro vc-call (fun file &rest args)
- ;; BEWARE!! `file' is evaluated twice!!
+ "A convenience macro for calling VC backend functions.
+Functions called by this macro must accept FILE as the first argument.
+ARGS specifies any additional arguments. FUN should be unquoted.
+BEWARE!! `file' is evaluated twice!!"
`(vc-call-backend (vc-backend ,file) ',fun ,file ,@args))
\f
(defsubst vc-parse-buffer (pattern i)
(set-buffer-modified-p nil)
t))
-(defun vc-find-root (file witness)
+(defun vc-find-root (file witness &optional invert)
"Find the root of a checked out project.
The function walks up the directory tree from FILE looking for WITNESS.
-If WITNESS if not found, return nil, otherwise return the root."
+If WITNESS if not found, return nil, otherwise return the root.
+Optional arg INVERT non-nil reverses the sense of the check;
+the root is the last directory for which WITNESS *is* found."
;; Represent /home/luser/foo as ~/foo so that we don't try to look for
;; witnesses in /home or in /.
(setq file (abbreviate-file-name file))
(let ((root nil)
+ (prev-file file)
;; `user' is not initialized outside the loop because
;; `file' may not exist, so we may have to walk up part of the
;; hierarchy before we find the "initial UID".
- (user nil))
+ (user nil)
+ try)
(while (not (or root
(null file)
;; As a heuristic, we stop looking up the hierarchy of
(setq user (nth 2 (file-attributes file)))
(and prev-user (not (equal user prev-user))))
(string-match vc-ignore-dir-regexp file)))
- (if (file-exists-p (expand-file-name witness file))
- (setq root file)
- (if (equal file
- (setq file (file-name-directory (directory-file-name file))))
- (setq file nil))))
+ (setq try (file-exists-p (expand-file-name witness file)))
+ (cond ((and invert (not try)) (setq root prev-file))
+ ((and (not invert) try) (setq root file))
+ ((equal file (setq prev-file file
+ file (file-name-directory
+ (directory-file-name file))))
+ (setq file nil))))
+ ;; Handle the case where ~/WITNESS exists and the original FILE is "~".
+ ;; (This occurs, for example, when placing dotfiles under RCS.)
+ (when (and (not root) invert prev-file)
+ (setq root prev-file))
root))
;; Access functions to file properties
backend is tried first."
(let (handler)
(cond
- ((string-match vc-ignore-dir-regexp (file-name-directory file)) nil)
+ ((and (file-name-directory file) (string-match vc-ignore-dir-regexp (file-name-directory file)))
+ nil)
((and (boundp 'file-name-handler-alist)
(setq handler (find-file-name-handler file 'vc-registered)))
;; handler should set vc-backend and return t if registered
;; Try vc-BACKEND-registered for each handled BACKEND.
(catch 'found
(let ((backend (vc-file-getprop file 'vc-backend)))
- (mapcar
+ (mapc
(lambda (b)
(and (vc-call-backend b 'registered file)
(vc-file-setprop file 'vc-backend b)
(vc-file-setprop file 'vc-backend 'none)
nil)))))
-(defun vc-backend (file)
- "Return the version control type of FILE, nil if it is not registered."
+(defun vc-backend (file-or-list)
+ "Return the version control type of FILE-OR-LIST, nil if it's not registered.
+If the argument is a list, the files must all have the same back end."
;; `file' can be nil in several places (typically due to the use of
;; code like (vc-backend buffer-file-name)).
- (when (stringp file)
- (let ((property (vc-file-getprop file 'vc-backend)))
- ;; Note that internally, Emacs remembers unregistered
- ;; files by setting the property to `none'.
- (cond ((eq property 'none) nil)
- (property)
- ;; vc-registered sets the vc-backend property
- (t (if (vc-registered file)
- (vc-file-getprop file 'vc-backend)
- nil))))))
+ (cond ((stringp file-or-list)
+ (let ((property (vc-file-getprop file-or-list 'vc-backend)))
+ ;; Note that internally, Emacs remembers unregistered
+ ;; files by setting the property to `none'.
+ (cond ((eq property 'none) nil)
+ (property)
+ ;; vc-registered sets the vc-backend property
+ (t (if (vc-registered file-or-list)
+ (vc-file-getprop file-or-list 'vc-backend)
+ nil)))))
+ ((and file-or-list (listp file-or-list))
+ (vc-backend (car file-or-list)))
+ (t
+ nil)))
+
(defun vc-backend-subdirectory-name (file)
"Return where the master and lock FILEs for the current directory are kept."
the master file. This state can only occur if locking
is not used for the file.
- 'unlocked-changes The current version of the working file is not locked,
+ 'unlocked-changes The working version of the file is not locked,
but the working file has been changed with respect
to that version. This state can only occur for files
with locking; it represents an erroneous condition that
should be resolved by the user (vc-next-action will
- prompt the user to do it)."
+ prompt the user to do it).
+
+ 'added Scheduled to go into the repository on the next commit.
+ Often represented by vc-working-revision = \"0\" in VCSes
+ with monotonic IDs like Subversion and Mercurial.
+
+ 'removed Scheduled to be deleted from the repository on next commit.
+
+ 'missing The file is not present in the file system, but the VC
+ system still tracks it.
+
+ 'ignored The file showed up in a dir-state listing with a flag
+ indicating the version-control system is ignoring it,
+ Note: This property is not set reliably (some VCSes
+ don't have useful directory-status commands) so assume
+ that any file with vc-state nil might be ignorable
+ without VC knowing it.
+
+ 'unregistered The file showed up in a dir-state listing with a flag
+ indicating that it is not under version control.
+ Note: This property is not set reliably (some VCSes
+ don't have useful directory-status commands) so assume
+ that any file with vc-state nil might be unregistered
+ without VC knowing it.
+
+A return of nil from this function means we have no information on the
+status of this file.
+"
+ ;; Note: in Emacs 22 and older, return of nil meant the file was unregistered.
+ ;; This is potentially a source of backward-compatibility bugs.
+
;; FIXME: New (sub)states needed (?):
- ;; - `added' (i.e. `edited' but with no base version yet,
- ;; typically represented by vc-workfile-version = "0")
;; - `conflict' (i.e. `edited' with conflict markers)
;; - `removed'
;; - `copied' and `moved' (might be handled by `removed' and `added')
(or (vc-file-getprop file 'vc-state)
- (if (vc-backend file)
+ (if (and (> (length file) 0) (vc-backend file))
(vc-file-setprop file 'vc-state
(vc-call state-heuristic file)))))
(zerop (condition-case err
;; If the implementation supports it, let the output
;; go to *vc*, not *vc-diff*, since this is an internal call.
- (vc-call diff file nil nil "*vc*")
+ (vc-call diff (list file) nil nil "*vc*")
(wrong-number-of-arguments
;; If this error came from the above call to vc-BACKEND-diff,
;; try again without the optional buffer argument (for
'diff))))
(not (eq (caddr err) 4)))
(signal (car err) (cdr err))
- (vc-call diff file))))))
+ (vc-call diff (list file)))))))
-(defun vc-workfile-version (file)
- "Return the version level of the current workfile FILE.
+(defun vc-working-revision (file)
+ "Return the repository version from which FILE was checked out.
If FILE is not registered, this function always returns nil."
- (or (vc-file-getprop file 'vc-workfile-version)
+ (or (vc-file-getprop file 'vc-working-revision)
(if (vc-backend file)
- (vc-file-setprop file 'vc-workfile-version
- (vc-call workfile-version file)))))
+ (vc-file-setprop file 'vc-working-revision
+ (vc-call working-revision file)))))
+;; Backward compatibility.
+(define-obsolete-function-alias
+ 'vc-workfile-version 'vc-working-revision "23.1")
+(define-obsolete-function-alias
+ 'vc-previous-version 'vc-previous-revision "23.1")
+(defun vc-default-working-revision (backend file)
+ (message
+ "`working-revision' not found: using the old `workfile-version' instead")
+ (vc-call-backend backend 'workfile-version file))
(defun vc-default-registered (backend file)
"Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
"\\.~.+" (unless manual "\\.") "~")
(expand-file-name (concat (file-name-nondirectory file)
".~" (subst-char-in-string
- ?/ ?_ (or rev (vc-workfile-version file)))
+ ?/ ?_ (or rev (vc-working-revision file)))
(unless manual ".") "~")
(file-name-directory file))))
(defun vc-delete-automatic-version-backups (file)
"Delete all existing automatic version backups for FILE."
(condition-case nil
- (mapcar
+ (mapc
'delete-file
(directory-files (or (file-name-directory file) default-directory) t
(vc-version-backup-file-name file nil nil t)))
;; and version backups should be made, copy the file to
;; another name. This enables local diffs and local reverting.
(let ((file buffer-file-name))
- (and (vc-backend file)
- (vc-up-to-date-p file)
- (eq (vc-checkout-model file) 'implicit)
- (vc-call make-version-backups-p file)
- (vc-make-version-backup file))))
+ (ignore-errors ;Be careful not to prevent saving the file.
+ (and (vc-backend file)
+ (vc-up-to-date-p file)
+ (eq (vc-checkout-model file) 'implicit)
+ (vc-call make-version-backups-p file)
+ (vc-make-version-backup file)))))
+
+(declare-function vc-dired-resynch-file "vc" (file))
(defun vc-after-save ()
"Function to be called by `basic-save-buffer' (in files.el)."
(let ((backend (vc-backend file)))
(if (not backend)
(setq vc-mode nil)
- (setq vc-mode (concat " " (if vc-display-status
- (vc-call mode-line-string file)
- (symbol-name backend))))
+ (let* ((ml-string (vc-call mode-line-string file))
+ (ml-echo (get-text-property 0 'help-echo ml-string)))
+ (setq vc-mode
+ (concat
+ " "
+ (if (null vc-display-status)
+ (symbol-name backend)
+ (propertize
+ ml-string
+ 'mouse-face 'mode-line-highlight
+ 'help-echo
+ (concat (or ml-echo
+ (format "File under the %s version control system"
+ backend))
+ "\nmouse-1: Version Control menu")
+ 'local-map vc-mode-line-map)))))
;; If the file is locked by some other user, make
;; the buffer read-only. Like this, even root
;; cannot modify a file that someone else has locked.
This function assumes that the file is registered."
(setq backend (symbol-name backend))
(let ((state (vc-state file))
- (rev (vc-workfile-version file)))
- (cond ((or (eq state 'up-to-date)
- (eq state 'needs-patch))
- (concat backend "-" rev))
- ((stringp state)
- (concat backend ":" state ":" rev))
- (t
- ;; Not just for the 'edited state, but also a fallback
- ;; for all other states. Think about different symbols
- ;; for 'needs-patch and 'needs-merge.
- (concat backend ":" rev)))))
+ (state-echo nil)
+ (rev (vc-working-revision file)))
+ (propertize
+ (cond ((or (eq state 'up-to-date)
+ (eq state 'needs-patch))
+ (setq state-echo "Up to date file")
+ (concat backend "-" rev))
+ ((stringp state)
+ (setq state-echo (concat "File locked by" state))
+ (concat backend ":" state ":" rev))
+ ((eq state 'added)
+ (setq state-echo "Locally added file")
+ (concat backend "@" rev))
+ ((eq state 'removed)
+ (setq state-echo "File removed from the VC system")
+ (concat backend "!" rev))
+ ((eq state 'missing)
+ (setq state-echo "File tracked by the VC system, but missing from the file system")
+ (concat backend "?" rev))
+ (t
+ ;; Not just for the 'edited state, but also a fallback
+ ;; for all other states. Think about different symbols
+ ;; for 'needs-patch and 'needs-merge.
+ (setq state-echo "Locally modified file")
+ (concat backend ":" rev)))
+ 'help-echo (concat state-echo " under the " backend
+ " version control system"))))
(defun vc-follow-link ()
"If current buffer visits a symbolic link, visit the real file.
(when buffer-file-name
(vc-file-clearprops buffer-file-name)
(cond
- ((ignore-errors (vc-backend buffer-file-name))
+ ((with-demoted-errors (vc-backend buffer-file-name))
;; Compute the state and put it in the modeline.
(vc-mode-line buffer-file-name)
(unless vc-make-backup-files
(let ((map (make-sparse-keymap)))
(define-key map "a" 'vc-update-change-log)
(define-key map "b" 'vc-switch-backend)
- (define-key map "c" 'vc-cancel-version)
+ (define-key map "c" 'vc-rollback)
(define-key map "d" 'vc-directory)
(define-key map "g" 'vc-annotate)
(define-key map "h" 'vc-insert-headers)
(define-key map "m" 'vc-merge)
(define-key map "r" 'vc-retrieve-snapshot)
(define-key map "s" 'vc-create-snapshot)
- (define-key map "u" 'vc-revert-buffer)
+ (define-key map "u" 'vc-revert)
(define-key map "v" 'vc-next-action)
+ (define-key map "+" 'vc-update)
(define-key map "=" 'vc-diff)
- (define-key map "~" 'vc-version-other-window)
+ (define-key map "~" 'vc-revision-other-window)
+ ;; `vc-status' is a not-quite-ready replacement for `vc-directory'
+ ;; (define-key map "?" 'vc-status)
map))
(fset 'vc-prefix-map vc-prefix-map)
(define-key global-map "\C-xv" 'vc-prefix-map)
;;(define-key map [show-files]
;; '("Show Files under VC" . (vc-directory t)))
(define-key map [vc-retrieve-snapshot]
- '("Retrieve Snapshot" . vc-retrieve-snapshot))
+ '(menu-item "Retrieve Snapshot" vc-retrieve-snapshot
+ :help "Retrieve snapshot"))
(define-key map [vc-create-snapshot]
- '("Create Snapshot" . vc-create-snapshot))
- (define-key map [vc-directory] '("VC Directory Listing" . vc-directory))
+ '(menu-item "Create Snapshot" vc-create-snapshot
+ :help "Create Snapshot"))
+ (define-key map [vc-directory]
+ '(menu-item "VC Directory Listing" vc-directory
+ :help "Show the VC status of files in a directory"))
+ ;; `vc-status' is a not-quite-ready replacement for `vc-directory'
+ ;; (define-key map [vc-status] '("VC Status" . vc-status))
(define-key map [separator1] '("----"))
- (define-key map [vc-annotate] '("Annotate" . vc-annotate))
- (define-key map [vc-rename-file] '("Rename File" . vc-rename-file))
- (define-key map [vc-version-other-window]
- '("Show Other Version" . vc-version-other-window))
- (define-key map [vc-diff] '("Compare with Base Version" . vc-diff))
+ (define-key map [vc-annotate]
+ '(menu-item "Annotate" vc-annotate
+ :help "Display the edit history of the current file using colors"))
+ (define-key map [vc-rename-file]
+ '(menu-item "Rename File" vc-rename-file
+ :help "Rename file"))
+ (define-key map [vc-revision-other-window]
+ '(menu-item "Show Other Version" vc-revision-other-window
+ :help "Visit another version of the current file in another window"))
+ (define-key map [vc-diff]
+ '(menu-item "Compare with Base Version" vc-diff
+ :help "Compare file set with the base version"))
(define-key map [vc-update-change-log]
- '("Update ChangeLog" . vc-update-change-log))
- (define-key map [vc-print-log] '("Show History" . vc-print-log))
+ '(menu-item "Update ChangeLog" vc-update-change-log
+ :help "Find change log file and add entries from recent version control logs"))
+ (define-key map [vc-print-log]
+ '(menu-item "Show History" vc-print-log
+ :help "List the change log of the current file set in a window"))
(define-key map [separator2] '("----"))
(define-key map [vc-insert-header]
- '("Insert Header" . vc-insert-headers))
- (define-key map [undo] '("Undo Last Check-In" . vc-cancel-version))
- (define-key map [vc-revert-buffer]
- '("Revert to Base Version" . vc-revert-buffer))
+ '(menu-item "Insert Header" vc-insert-headers
+ :help "Insert headers into a file for use with a version control system.
+"))
+ (define-key map [undo]
+ '(menu-item "Undo Last Check-In" vc-rollback
+ :help "Remove the most recent changeset committed to the repository"))
+ (define-key map [vc-revert]
+ '(menu-item "Revert to Base Version" vc-revert
+ :help "Revert working copies of the selected file set to their repository contents"))
(define-key map [vc-update]
- '("Update to Latest Version" . vc-update))
- (define-key map [vc-next-action] '("Check In/Out" . vc-next-action))
- (define-key map [vc-register] '("Register" . vc-register))
+ '(menu-item "Update to Latest Version" vc-update
+ :help "Update the current fileset's files to their tip revisions"))
+ (define-key map [vc-next-action]
+ '(menu-item "Check In/Out" vc-next-action
+ :help "Do the next logical version control operation on the current fileset"))
+ (define-key map [vc-register]
+ '(menu-item "Register" vc-register
+ :help "Register file set into a version control system"))
map))
(defalias 'vc-menu-map vc-menu-map)
+(declare-function vc-responsible-backend "vc" (file &optional register))
+
(defun vc-menu-map-filter (orig-binding)
(if (and (symbolp orig-binding) (fboundp orig-binding))
(setq orig-binding (indirect-function orig-binding)))
(let ((ext-binding
- (if vc-mode (vc-call-backend (vc-backend buffer-file-name)
- 'extra-menu))))
+ (when vc-mode
+ (vc-call-backend
+ (if buffer-file-name
+ (vc-backend buffer-file-name)
+ (vc-responsible-backend default-directory))
+ 'extra-menu))))
;; Give the VC backend a chance to add menu entries
;; specific for that backend.
(if (null ext-binding)
;;(put 'vc-rename-file 'menu-enable 'vc-mode)
;;(put 'vc-annotate 'menu-enable '(eq (vc-buffer-backend) 'CVS))
-;;(put 'vc-version-other-window 'menu-enable 'vc-mode)
+;;(put 'vc-revision-other-window 'menu-enable 'vc-mode)
;;(put 'vc-diff 'menu-enable 'vc-mode)
;;(put 'vc-update-change-log 'menu-enable
;; '(member (vc-buffer-backend) '(RCS CVS)))
;;(put 'vc-print-log 'menu-enable 'vc-mode)
-;;(put 'vc-cancel-version 'menu-enable 'vc-mode)
-;;(put 'vc-revert-buffer 'menu-enable 'vc-mode)
+;;(put 'vc-rollback 'menu-enable 'vc-mode)
+;;(put 'vc-revert 'menu-enable 'vc-mode)
;;(put 'vc-insert-headers 'menu-enable 'vc-mode)
;;(put 'vc-next-action 'menu-enable 'vc-mode)
;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))
HCoop / bpt / emacs.git / blobdiff