]> code.delx.au - gnu-emacs/blobdiff - lisp/vc-hooks.el
*** empty log message ***
[gnu-emacs] / lisp / vc-hooks.el
index be39f7d9d5cc84f41501665edda77e227f52afdf..2dc8e1533f0d88045a605cab65d0b8d622df3b41 100644 (file)
@@ -1,12 +1,12 @@
 ;;; vc-hooks.el --- resident support for version-control
 
-;; Copyright (C) 1992,93,94,95,96,98,99,2000,03,2004
+;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2003, 2004
 ;;           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.
 
                         "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.
@@ -266,7 +272,6 @@ It is usually called via the `vc-call' macro."
 (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."
@@ -299,6 +304,20 @@ non-nil if FILE exists and its contents were successfully inserted."
     (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
@@ -316,11 +335,13 @@ on the result of a previous call, use `vc-backend' instead.  If the
 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
@@ -335,7 +356,7 @@ backend is tried first."
             (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."
@@ -440,6 +461,12 @@ For registered files, the value returned is one of:
           (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))
@@ -463,15 +490,21 @@ and does not employ any heuristic at all."
 (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.
@@ -727,8 +760,8 @@ current, and kill the buffer that visits the link."
        (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
@@ -766,7 +799,7 @@ Used in `find-file-not-found-functions'."
   ;; 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
@@ -864,5 +897,5 @@ Used in `find-file-not-found-functions'."
 
 (provide 'vc-hooks)
 
-;;; arch-tag: 2e5a6fa7-1d30-48e2-8bd0-e3d335f04f32
+;; arch-tag: 2e5a6fa7-1d30-48e2-8bd0-e3d335f04f32
 ;;; vc-hooks.el ends here