;;; vc-hooks.el --- resident support for version-control
-;; Copyright (C) 1992,93,94,95,96,98,99,2000,03,2004
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2002,
+;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
-;; $Id: vc-hooks.el,v 1.162 2004/03/21 15:44:39 spiegel Exp $
+;; $Id$
;; This file is part of GNU Emacs.
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
"set `vc-handled-backends' to nil to disable VC.")
(defvar vc-master-templates ())
-(make-obsolete-variable 'vc-master-templates
- "to define master templates for a given BACKEND, use
+(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'.")
(defvar vc-header-alist ())
(make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header)
+(defvar vc-ignore-dir-regexp "\\`\\([\\/][\\/]\\|/net/\\|/afs/\\)\\'"
+ "Regexp matching directory names that are not under VC's control.
+The default regexp prevents fruitless and time-consuming attempts
+to determine the VC status in directories in which filenames are
+interpreted as hostnames.")
+
(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.
(set :format "%v" :inline t (const :format "%t" :tag "don't" except))
(regexp :format " stay local,\n%t: %v" :tag "if it matches")
(repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
- :version "21.4"
+ :version "22.1"
:group 'vc)
(defun vc-stay-local-p (file)
(defmacro vc-call (fun file &rest args)
;; BEWARE!! `file' is evaluated twice!!
`(vc-call-backend (vc-backend ,file) ',fun ,file ,@args))
-
\f
(defsubst vc-parse-buffer (pattern i)
"Find PATTERN in the current buffer and return its Ith submatch."
(set-buffer-modified-p nil)
t))
+(defun vc-find-root (file witness)
+ "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."
+ (let ((root nil))
+ (while (not (or root
+ (equal file (setq file (file-name-directory file)))
+ (null 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))))
+ root))
+
;; Access functions to file properties
;; (Properties should be _set_ using vc-file-setprop, but
;; _retrieved_ only through these functions, which decide
file was previously registered under a certain backend, then that
backend is tried first."
(let (handler)
- (if (boundp 'file-name-handler-alist)
- (setq handler (find-file-name-handler file 'vc-registered)))
- (if handler
- ;; handler should set vc-backend and return t if registered
- (funcall handler 'vc-registered file)
+ (cond
+ ((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
+ (funcall handler 'vc-registered file))
+ (t
;; There is no file name handler.
;; Try vc-BACKEND-registered for each handled BACKEND.
(catch 'found
(cons backend vc-handled-backends))))
;; File is not registered.
(vc-file-setprop file 'vc-backend 'none)
- nil))))
+ nil)))))
(defun vc-backend (file)
"Return the version control type of FILE, nil if it is not registered."
(vc-file-setprop file 'vc-checkout-model
(vc-call checkout-model file)))))
-(defun vc-user-login-name (&optional uid)
- "Return the name under which the user is logged in, as a string.
-\(With optional argument UID, return the name of that user.)
-This function does the same as function `user-login-name', but unlike
-that, it never returns nil. If a UID cannot be resolved, that
-UID is returned as a string."
- (or (user-login-name uid)
- (number-to-string (or uid (user-uid)))))
+(defun vc-user-login-name (file)
+ "Return the name under which the user accesses the given FILE."
+ (or (and (eq (string-match tramp-file-name-regexp file) 0)
+ ;; tramp case: execute "whoami" via tramp
+ (let ((default-directory (file-name-directory file)))
+ (with-temp-buffer
+ (if (not (zerop (process-file "whoami" nil t)))
+ ;; fall through if "whoami" didn't work
+ nil
+ ;; remove trailing newline
+ (delete-region (1- (point-max)) (point-max))
+ (buffer-string)))))
+ ;; normal case
+ (user-login-name)
+ ;; if user-login-name is nil, return the UID as a string
+ (number-to-string (user-uid))))
(defun vc-state (file)
"Return the version control state of 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)))
+
(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))
"Return non-nil if FILE has not changed since the last checkout."
(let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
(lastmod (nth 5 (file-attributes file))))
- (if checkout-time
+ (if (and checkout-time
+ ;; Tramp and Ange-FTP return this when they don't know the time.
+ (not (equal lastmod '(0 0))))
(equal checkout-time lastmod)
(let ((unchanged (vc-call workfile-unchanged-p file)))
(vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
(defun vc-default-workfile-unchanged-p (backend file)
"Check if FILE is unchanged by diffing against the master version.
Return non-nil if FILE is unchanged."
- (let ((diff-args-length
- (length (cadr (symbol-function
- (vc-find-backend-function backend 'diff))))))
- (zerop (if (> diff-args-length 4)
- ;; 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*")
- ;; for backward compatibility
- (vc-call diff 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*")
+ (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))))
+ (not (eq (caddr err) 4)))
+ (signal (car err) (cdr err))
+ (vc-call diff file))))))
(defun vc-workfile-version (file)
"Return the version level of the current workfile FILE.
(unless (and (fboundp 'msdos-long-file-names)
(not (with-no-warnings (msdos-long-file-names))))
(vc-delete-automatic-version-backups file)
- (copy-file file (vc-version-backup-file-name file)
- nil 'keep-date)))
+ (condition-case nil
+ (copy-file file (vc-version-backup-file-name file)
+ nil 'keep-date)
+ ;; It's ok if it doesn't work (e.g. directory not writable),
+ ;; since this is just for efficiency.
+ (file-error
+ (message
+ (concat "Warning: Cannot make version backup; "
+ "diff/revert therefore not local"))))))
(defun vc-before-save ()
"Function to be called by `basic-save-buffer' (in files.el)."
(set (make-local-variable 'backup-inhibited) t))
;; Let the backend setup any buffer-local things he needs.
(vc-call-backend (vc-backend buffer-file-name) 'find-file-hook))
- ((let* ((link (file-symlink-p buffer-file-name))
- (link-type (and link (vc-backend (file-chase-links link)))))
+ ((let ((link-type (and (file-symlink-p buffer-file-name)
+ (vc-backend (file-chase-links buffer-file-name)))))
(cond ((not link-type) nil) ;Nothing to do.
((eq vc-follow-symlinks nil)
(message
;; 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))))
+ (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
(provide 'vc-hooks)
-;;; arch-tag: 2e5a6fa7-1d30-48e2-8bd0-e3d335f04f32
+;; arch-tag: 2e5a6fa7-1d30-48e2-8bd0-e3d335f04f32
;;; vc-hooks.el ends here