;;; 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
(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 Arch MCVS)
- ;; BZR, GIT, HG, Arch and MCVS come last because they are per-tree
- ;; rather than per-dir.
+(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.
: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.
+(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)
(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)
(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
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)
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.
+
+ '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-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 (and (> (length file) 0) (vc-backend file))
- (vc-file-setprop file 'vc-state
- (vc-call state-heuristic file)))))
+ (when (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.
(signal (car err) (cdr err))
(vc-call diff (list file)))))))
-(defun vc-workfile-version (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)
- (if (vc-backend file)
- (vc-file-setprop file 'vc-workfile-version
- (vc-call workfile-version file)))))
+ (or (vc-file-getprop file 'vc-working-revision)
+ (when (vc-backend 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."
(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))))
"\\.~.+" (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)."
(eq (vc-checkout-model 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)))))
+ (when (featurep 'vc)
+ ;; If VC is not loaded, then there can't be
+ ;; 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-map)
+ (define-key map [mode-line down-mouse-1] vc-menu-entry)
map))
(defun vc-mode-line (file)
(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))
(setq backend (symbol-name backend))
(let ((state (vc-state file))
(state-echo nil)
- (rev (vc-workfile-version file)))
+ (rev (vc-working-revision file)))
(propertize
(cond ((or (eq state 'up-to-date)
(eq state 'needs-patch))
((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
;; 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)
- (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)
(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 "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-dir' is a not-quite-ready replacement for `vc-directory'
+ ;; (define-key map "?" 'vc-dir)
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-rollback))
- (define-key vc-menu-map [vc-revert]
- '("Revert to Base Version" . vc-revert))
- (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]
+ '(menu-item "Retrieve Snapshot" vc-retrieve-snapshot
+ :help "Retrieve snapshot"))
+ (define-key map [vc-create-snapshot]
+ '(menu-item "Create Snapshot" vc-create-snapshot
+ :help "Create Snapshot"))
+ (define-key map [separator1] '("----"))
+ (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]
+ '(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]
+ '(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]
+ '(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
+ (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)
+ orig-binding
+ (append orig-binding
+ '((ext-menu-separator "---"))
+ ext-binding))))
(defun vc-default-extra-menu (backend)
nil)
;;(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)))
HCoop / bpt / emacs.git / blobdiff