;;; 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
: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")
(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
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-working-revision = "0")
;; - `conflict' (i.e. `edited' with conflict markers)
;; - `removed'
;; - `copied' and `moved' (might be handled by `removed' and `added')
;; 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")
;; 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)."
(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))
((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
(define-key map "+" 'vc-update)
(define-key map "=" 'vc-diff)
(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-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"))
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)
HCoop / bpt / emacs.git / blobdiff