;; 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
(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
'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
;; 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))
((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-create-snapshot]
'(menu-item "Create Snapshot" vc-create-snapshot
:help "Create Snapshot"))
- (define-key map [vc-directory]
+ (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]
+ (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]
+ (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]
+ (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]
+ (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] '("----"))
'(menu-item "Insert Header" vc-insert-headers
:help "Insert headers into a file for use with a version control system.
"))
- (define-key map [undo]
+ (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]
(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]
+ (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]
+ (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