;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
:type 'regexp
:group 'vc)
-(defcustom vc-handled-backends '(RCS CVS SVN SCCS Arch MCVS)
- ;; Arch and MCVS come last because they are per-tree rather than per-dir.
- "*List of version control backends for which VC will be used.
+(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch MCVS)
+ ;; RCS, CVS, SVN and SCCS come first because they are per-dir
+ ;; rather than per-tree. RCS comes first because of the multibackend
+ ;; support intended to use RCS for local commits (with a remote CVS server).
+ "List of version control backends for which VC will be used.
Entries in this list will be tried in order to determine whether a
file is under that sort of version control.
Removing an entry from the list prevents VC from being activated
when visiting a file managed by that backend.
An empty list disables VC altogether."
:type '(repeat symbol)
- :version "21.1"
+ :version "23.1"
: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)
If WITNESS if not found, return nil, otherwise return the root."
;; Represent /home/luser/foo as ~/foo so that we don't try to look for
;; witnesses in /home or in /.
+ (while (not (file-directory-p file))
+ (setq file (file-name-directory (directory-file-name file))))
(setq file (abbreviate-file-name file))
(let ((root nil)
(user (nth 2 (file-attributes file))))
(while (not (or root
- (equal file (setq file (file-name-directory file)))
- (null file)
- ;; As a heuristic, we stop looking up the hierarchy of
- ;; directories as soon as we find a directory belonging
- ;; to another user. This should save us from looking in
- ;; things like /net and /afs. This assumes that all the
- ;; files inside a project belong to the same user.
- (not (equal user (nth 2 (file-attributes file))))
- (string-match vc-ignore-dir-regexp file)))
+ (null file)
+ ;; As a heuristic, we stop looking up the hierarchy of
+ ;; directories as soon as we find a directory belonging
+ ;; to another user. This should save us from looking in
+ ;; things like /net and /afs. This assumes that all the
+ ;; files inside a project belong to the same user.
+ (not (equal user (nth 2 (file-attributes file))))
+ (string-match vc-ignore-dir-regexp file)))
(if (file-exists-p (expand-file-name witness file))
- (setq root file)
- (setq file (directory-file-name file))))
+ (setq root file)
+ (if (equal file
+ (setq file (file-name-directory (directory-file-name file))))
+ (setq file nil))))
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."
prompt the user to do it)."
;; FIXME: New (sub)states needed (?):
;; - `added' (i.e. `edited' but with no base version yet,
- ;; typically represented by vc-workfile-version = "0")
+ ;; typically represented by vc-working-revision = "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")
+(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)))
(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)."
;; If the file in the current buffer is under version control,
;; any VC Dired buffer to synchronize.
(vc-dired-resynch-file file)))))
+(defvar vc-menu-entry
+ '(menu-item "Version Control" vc-menu-map
+ :filter vc-menu-map-filter))
+
+(when (boundp 'menu-bar-tools-menu)
+ ;; We do not need to worry here about the placement of this entry
+ ;; because menu-bar.el has already created the proper spot for us
+ ;; and this will simply use it.
+ (define-key menu-bar-tools-menu [vc] vc-menu-entry))
+
+(defconst vc-mode-line-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line down-mouse-1] vc-menu-entry)
+ map))
+
(defun vc-mode-line (file)
"Set `vc-mode' to display type of version control for FILE.
The value is set in the current buffer, which should be the buffer
(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))
+ (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
- ((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
(if backend (vc-call-backend backend 'find-file-not-found-hook))))
(defun vc-default-find-file-not-found-hook (backend)
- (if (yes-or-no-p
- (format "File %s was lost; check out from version control? "
- (file-name-nondirectory buffer-file-name)))
- (save-excursion
- (require 'vc)
- (setq default-directory (file-name-directory buffer-file-name))
- (not (vc-error-occurred (vc-checkout buffer-file-name))))))
+ ;; This used to do what vc-rcs-find-file-not-found-hook does, but it only
+ ;; really makes sense for RCS. For other backends, better not do anything.
+ nil)
(add-hook 'find-file-not-found-functions 'vc-file-not-found-hook)
(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)
map))
(fset 'vc-prefix-map vc-prefix-map)
(define-key global-map "\C-xv" 'vc-prefix-map)
-(if (not (boundp 'vc-menu-map))
- ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar
- ;; vc-menu-map.
- ()
- ;;(define-key vc-menu-map [show-files]
- ;; '("Show Files under VC" . (vc-directory t)))
- (define-key vc-menu-map [vc-retrieve-snapshot]
- '("Retrieve Snapshot" . vc-retrieve-snapshot))
- (define-key vc-menu-map [vc-create-snapshot]
- '("Create Snapshot" . vc-create-snapshot))
- (define-key vc-menu-map [vc-directory] '("VC Directory Listing" . vc-directory))
- (define-key vc-menu-map [separator1] '("----"))
- (define-key vc-menu-map [vc-annotate] '("Annotate" . vc-annotate))
- (define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file))
- (define-key vc-menu-map [vc-version-other-window]
- '("Show Other Version" . vc-version-other-window))
- (define-key vc-menu-map [vc-diff] '("Compare with Base Version" . vc-diff))
- (define-key vc-menu-map [vc-update-change-log]
- '("Update ChangeLog" . vc-update-change-log))
- (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log))
- (define-key vc-menu-map [separator2] '("----"))
- (define-key vc-menu-map [vc-insert-header]
- '("Insert Header" . vc-insert-headers))
- (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version))
- (define-key vc-menu-map [vc-revert-buffer]
- '("Revert to Base Version" . vc-revert-buffer))
- (define-key vc-menu-map [vc-update]
- '("Update to Latest Version" . vc-update))
- (define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action))
- (define-key vc-menu-map [vc-register] '("Register" . vc-register)))
+(defvar vc-menu-map
+ (let ((map (make-sparse-keymap "Version Control")))
+ ;;(define-key map [show-files]
+ ;; '("Show Files under VC" . (vc-directory t)))
+ (define-key map [vc-retrieve-snapshot]
+ '("Retrieve Snapshot" . vc-retrieve-snapshot))
+ (define-key map [vc-create-snapshot]
+ '("Create Snapshot" . vc-create-snapshot))
+ (define-key map [vc-directory] '("VC Directory Listing" . vc-directory))
+ (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-revision-other-window]
+ '("Show Other Version" . vc-revision-other-window))
+ (define-key map [vc-diff] '("Compare with Base Version" . vc-diff))
+ (define-key map [vc-update-change-log]
+ '("Update ChangeLog" . vc-update-change-log))
+ (define-key map [vc-print-log] '("Show History" . vc-print-log))
+ (define-key map [separator2] '("----"))
+ (define-key map [vc-insert-header]
+ '("Insert Header" . vc-insert-headers))
+ (define-key map [undo] '("Undo Last Check-In" . vc-rollback))
+ (define-key map [vc-revert]
+ '("Revert to Base Version" . vc-revert))
+ (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))
+ map))
+
+(defalias 'vc-menu-map vc-menu-map)
+
+(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))))
+ ;; Give the VC backend a chance to add menu entries
+ ;; specific for that backend.
+ (if (null ext-binding)
+ orig-binding
+ (append orig-binding
+ '((ext-menu-separator "---"))
+ ext-binding))))
+
+(defun vc-default-extra-menu (backend)
+ nil)
;; These are not correct and it's not currently clear how doing it
;; better (with more complicated expressions) might slow things down
;;(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