;;; vc-hooks.el --- resident support for version-control
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-;; 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; 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
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defvar vc-ignore-vc-files nil)
(make-obsolete-variable 'vc-ignore-vc-files
- "set `vc-handled-backends' to nil to disable VC.")
+ "set `vc-handled-backends' to nil to disable VC."
+ "21.1")
(defvar vc-master-templates ())
(make-obsolete-variable 'vc-master-templates
"to define master templates for a given BACKEND, use
vc-BACKEND-master-templates. To enable or disable VC for a given
-BACKEND, use `vc-handled-backends'.")
+BACKEND, use `vc-handled-backends'."
+ "21.1")
(defvar vc-header-alist ())
-(make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header)
+(make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header "21.1")
(defcustom vc-ignore-dir-regexp
;; Stop SMB, automounter, AFS, and DFS host lookups.
:type 'regexp
:group 'vc)
-(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch MCVS)
+(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch)
;; 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).
:version "23.1"
:group 'vc)
-(defcustom vc-path
- (if (file-directory-p "/usr/sccs")
- '("/usr/sccs")
- nil)
+;; Note: we don't actually have a darcs back end yet.
+;; Also, Meta-CVS (corresponsding to MCVS) is unsupported.
+(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 nil
"List of extra directories to search for version control commands."
:type '(repeat directory)
:group 'vc)
(defmacro vc-call (fun file &rest args)
"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!!"
+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)
(when (file-exists-p file)
(if (not limit)
(insert-file-contents file)
- (if (not blocksize) (setq blocksize 8192))
+ (unless blocksize (setq blocksize 8192))
(let ((filepos 0))
(while
(and (< 0 (cadr (insert-file-contents
file nil filepos (incf filepos blocksize))))
(progn (beginning-of-line)
(let ((pos (re-search-forward limit nil 'move)))
- (if pos (delete-region (match-beginning 0)
- (point-max)))
+ (when pos (delete-region (match-beginning 0)
+ (point-max)))
(not pos)))))))
(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 /.
- (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))))
+ (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)
+ try)
(while (not (or root
(null file)
;; As a heuristic, we stop looking up the hierarchy of
;; 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))))
+ (let ((prev-user user))
+ (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
;; (Properties should be _set_ using vc-file-setprop, but
;; _retrieved_ only through these functions, which decide
-;; if the property is already known or not. A property should
+;; if the property is already known or not. A property should
;; only be retrieved by vc-file-getprop if there is no
;; access function.)
(vc-call-backend (vc-backend file) 'registered file))
(vc-file-getprop file 'vc-name))))
-(defun vc-checkout-model (file)
- "Indicate how FILE is checked out.
+(defun vc-checkout-model (backend files)
+ "Indicate how FILES are checked out.
-If FILE is not registered, this function always returns nil.
+If FILES are not registered, this function always returns nil.
For registered files, the possible values are:
- 'implicit FILE is always writeable, and checked out `implicitly'
+ 'implicit FILES are always writeable, and checked out `implicitly'
when the user saves the first changes to the file.
- 'locking FILE is read-only if up-to-date; user must type
+ 'locking FILES are read-only if up-to-date; user must type
\\[vc-next-action] before editing. Strict locking
is assumed.
- 'announce FILE is read-only if up-to-date; user must type
+ 'announce FILES are read-only if up-to-date; user must type
\\[vc-next-action] before editing. But other users
may be editing at the same time."
- (or (vc-file-getprop file 'vc-checkout-model)
- (if (vc-backend file)
- (vc-file-setprop file 'vc-checkout-model
- (vc-call checkout-model file)))))
+ (vc-call-backend backend 'checkout-model files))
(defun vc-user-login-name (file)
"Return the name under which the user accesses the given FILE."
USER The current version of the working file is locked by
some other USER (a string).
- 'needs-patch The file has not been edited by the user, but there is
+ 'needs-update The file has not been edited by the user, but there is
a more recent version on the current branch stored
in the master file.
'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 Mercxurial."
+ with monotonic IDs like Subversion and Mercurial.
+
+ 'removed Scheduled to be deleted from the repository on next commit.
+
+ 'conflict The file contains conflicts as the result of a merge.
+ For now the conflicts are text conflicts. In the
+ future this might be extended to deal with metadata
+ conflicts too.
+
+ '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-status 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 is not under version control.
+
+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 (?):
- ;; - `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 (and (> (length file) 0) (vc-backend file))
- (vc-file-setprop file 'vc-state
- (vc-call state-heuristic file)))))
-
-(defun vc-recompute-state (file)
- "Recompute the version control state of FILE, and return it.
-This calls the possibly expensive function vc-BACKEND-state,
-rather than the heuristic."
- (vc-file-setprop file 'vc-state (vc-call state file)))
+ (when (> (length file) 0)
+ (let ((backend (vc-backend file)))
+ (when backend
+ (vc-file-setprop
+ file 'vc-state
+ (vc-call-backend backend 'state-heuristic file)))))))
(defsubst vc-up-to-date-p (file)
"Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
(eq (vc-state file) 'up-to-date))
(defun vc-default-state-heuristic (backend file)
- "Default implementation of vc-state-heuristic.
+ "Default implementation of vc-BACKEND-state-heuristic.
It simply calls the real state computation function `vc-BACKEND-state'
and does not employ any heuristic at all."
(vc-call-backend backend 'state 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 (list file) nil nil "*vc*")
+ (vc-call-backend backend '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
;; backward compatibility). Otherwise, resignal.
(if (or (not (eq (cadr err)
(indirect-function
- (vc-find-backend-function (vc-backend file)
- 'diff))))
+ (vc-find-backend-function backend 'diff))))
(not (eq (caddr err) 4)))
(signal (car err) (cdr err))
- (vc-call diff (list file)))))))
+ (vc-call-backend backend 'diff (list 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-working-revision)
- (if (vc-backend file)
+ (let ((backend (vc-backend file)))
+ (when backend
(vc-file-setprop file 'vc-working-revision
- (vc-call working-revision file)))))
+ (vc-call-backend backend '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")
(mapcar
(lambda (s)
(let ((trial (vc-possible-master s dirname basename)))
- (if (and trial (file-exists-p trial)
- ;; Make sure the file we found with name
- ;; TRIAL is not the source file itself.
- ;; That can happen with RCS-style names if
- ;; the file name is truncated (e.g. to 14
- ;; chars). See if either directory or
- ;; attributes differ.
- (or (not (string= dirname
- (file-name-directory trial)))
- (not (equal (file-attributes file)
- (file-attributes trial)))))
+ (when (and trial (file-exists-p trial)
+ ;; Make sure the file we found with name
+ ;; TRIAL is not the source file itself.
+ ;; That can happen with RCS-style names if
+ ;; the file name is truncated (e.g. to 14
+ ;; chars). See if either directory or
+ ;; attributes differ.
+ (or (not (string= dirname
+ (file-name-directory trial)))
+ (not (equal (file-attributes file)
+ (file-attributes trial)))))
(throw 'found trial))))
templates))))
"Change read-only status of current buffer, perhaps via version control.
If the buffer is visiting a file registered with version control,
-then check the file in or out. Otherwise, just change the read-only flag
-of the buffer.
-With prefix argument, ask for version number to check in or check out.
-Check-out of a specified version number does not lock the file;
-to do that, use this command a second time with no argument.
-
-If you bind this function to \\[toggle-read-only], then Emacs checks files
-in or out whenever you toggle the read-only flag."
+throw an error, because this is not a safe or really meaningful operation
+on any version-control system newer than RCS.
+
+Otherwise, just change the read-only flag of the buffer.
+
+If you bind this function to \\[toggle-read-only], then Emacs
+will properly intercept all attempts to toggle the read-only flag
+on version-controlled buffer."
(interactive "P")
- (if (or (and (boundp 'vc-dired-mode) vc-dired-mode)
- ;; use boundp because vc.el might not be loaded
- (vc-backend buffer-file-name))
- (vc-next-action verbose)
+ (if (vc-backend buffer-file-name)
+ (error "Toggling the readability of a version controlled file is likely to wreak havoc.")
(toggle-read-only)))
(defun vc-default-make-version-backups-p (backend file)
;; If the file on disk is still in sync with the repository,
;; 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))))
+ (let ((file buffer-file-name)
+ backend)
+ (ignore-errors ;Be careful not to prevent saving the file.
+ (and (setq backend (vc-backend file))
+ (vc-up-to-date-p file)
+ (eq (vc-checkout-model backend (list file)) 'implicit)
+ (vc-call-backend backend 'make-version-backups-p file)
+ (vc-make-version-backup file)))))
-(declare-function vc-dired-resynch-file "vc" (file))
+(declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
(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,
;; up-to-date, and locking is not used for the file, set
;; the state to 'edited and redisplay the mode line.
- (let ((file buffer-file-name))
- (and (vc-backend file)
+ (let* ((file buffer-file-name)
+ (backend (vc-backend file)))
+ (and backend
(or (and (equal (vc-file-getprop file 'vc-checkout-time)
(nth 5 (file-attributes file)))
;; File has been saved in the same second in which
(vc-file-setprop file 'vc-checkout-time nil))
t)
(vc-up-to-date-p file)
- (eq (vc-checkout-model file) 'implicit)
+ (eq (vc-checkout-model backend (list file)) 'implicit)
(vc-file-setprop file 'vc-state 'edited)
(vc-mode-line file)
- (if (featurep 'vc)
- ;; If VC is not loaded, then there can't be
- ;; any VC Dired buffer to synchronize.
- (vc-dired-resynch-file file)))))
+ ;; Try to avoid unnecessary work, a *vc-dir* buffer is only
+ ;; present if this is true.
+ (when (memq 'vc-dir-resynch-file after-save-hook)
+ (vc-dir-resynch-file file)))))
(defvar vc-menu-entry
'(menu-item "Version Control" vc-menu-map
(let ((backend (vc-backend file)))
(if (not backend)
(setq vc-mode nil)
- (let* ((ml-string (vc-call mode-line-string file))
+ (let* ((ml-string (vc-call-backend backend 'mode-line-string file))
(ml-echo (get-text-property 0 'help-echo ml-string)))
(setq vc-mode
(concat
(propertize
ml-string
'mouse-face 'mode-line-highlight
- 'help-echo
+ 'help-echo
(concat (or ml-echo
(format "File under the %s version control system"
backend))
;; If the user is root, and the file is not owner-writable,
;; then pretend that we can't write it
;; even though we can (because root can write anything).
- ;; This way, even root cannot modify a file that isn't locked.
- (and (equal file buffer-file-name)
- (not buffer-read-only)
+ ;; This way, even root cannot modify a file that isn't locked.
+ (and (equal file buffer-file-name)
+ (not buffer-read-only)
(zerop (user-real-uid))
(zerop (logand (file-modes buffer-file-name) 128))
(setq buffer-read-only t)))
(rev (vc-working-revision file)))
(propertize
(cond ((or (eq state 'up-to-date)
- (eq state 'needs-patch))
+ (eq state 'needs-update))
(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 'conflict)
+ (setq state-echo "File contains conflicts after the last merge")
+ (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.
+ ;; for 'needs-update and 'needs-merge.
(setq state-echo "Locally modified file")
(concat backend ":" rev)))
'help-echo (concat state-echo " under the " backend
(setq vc-mode nil))
(when buffer-file-name
(vc-file-clearprops buffer-file-name)
+ (add-hook 'mode-line-hook 'vc-mode-line nil t)
(cond
((with-demoted-errors (vc-backend buffer-file-name))
;; Compute the state and put it in the modeline.
;; from a previous visit.
(vc-file-clearprops buffer-file-name)
(let ((backend (vc-backend buffer-file-name)))
- (if backend (vc-call-backend backend 'find-file-not-found-hook))))
+ (when backend (vc-call-backend backend 'find-file-not-found-hook))))
(defun vc-default-find-file-not-found-hook (backend)
;; This used to do what vc-rcs-find-file-not-found-hook does, but it only
(defun vc-kill-buffer-hook ()
"Discard VC info about a file when we kill its buffer."
- (if buffer-file-name
- (vc-file-clearprops buffer-file-name)))
+ (when buffer-file-name (vc-file-clearprops buffer-file-name)))
(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook)
(define-key map "a" 'vc-update-change-log)
(define-key map "b" 'vc-switch-backend)
(define-key map "c" 'vc-rollback)
- (define-key map "d" 'vc-directory)
+ (define-key map "d" 'vc-dir)
(define-key map "g" 'vc-annotate)
(define-key map "h" 'vc-insert-headers)
(define-key map "i" 'vc-register)
(define-key map "l" 'vc-print-log)
(define-key map "m" 'vc-merge)
- (define-key map "r" 'vc-retrieve-snapshot)
- (define-key map "s" 'vc-create-snapshot)
+ (define-key map "r" 'vc-retrieve-tag)
+ (define-key map "s" 'vc-create-tag)
(define-key map "u" 'vc-revert)
(define-key map "v" 'vc-next-action)
(define-key map "+" 'vc-update)
(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 [vc-retrieve-tag]
+ '(menu-item "Retrieve Tag" vc-retrieve-tag
+ :help "Retrieve tagged version or branch"))
+ (define-key map [vc-create-tag]
+ '(menu-item "Create Tag" vc-create-tag
+ :help "Create version tag"))
(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-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]
- '("Show Other Version" . vc-revision-other-window))
- (define-key map [vc-diff] '("Compare with Base Version" . vc-diff))
+ '(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-rollback))
+ '(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]
- '("Revert to Base Version" . 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"))
+ (define-key map [vc-dir]
+ '(menu-item "VC Dir" vc-dir
+ :help "Show the VC status of files in a directory"))
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)