]> code.delx.au - gnu-emacs/blobdiff - lisp/vc-hooks.el
(zmacs-regions): Add defvar.
[gnu-emacs] / lisp / vc-hooks.el
index 612d3747c9ed3b23a3be7449c862a859d560ada3..5872e2f1990aece9d2cf4f382a2842a8efdfb53b 100644 (file)
@@ -1,12 +1,12 @@
 ;;; vc-hooks.el --- resident support for version-control
 
-;; Copyright (C) 1992,93,94,95,96,98,99,2000,2003
-;;           Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2002,
+;;   2003, 2004, 2005 Free Software Foundation, Inc.
 
 ;; Author:     FSF (see vc.el for full credits)
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
 
-;; $Id: vc-hooks.el,v 1.156 2003/07/26 16:07:25 rost Exp $
+;; $Id$
 
 ;; This file is part of GNU Emacs.
 
@@ -22,8 +22,8 @@
 
 ;; 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:
 
 
 (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.")
 
 (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.")
+BACKEND, use `vc-handled-backends'.")
 
 (defvar vc-header-alist ())
 (make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header)
 
-(defcustom vc-handled-backends '(RCS CVS SVN MCVS SCCS)
+(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.
 Entries in this list will be tried in order to determine whether a
 file is under that sort of version control.
@@ -142,7 +149,7 @@ by these regular expressions."
                (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)
@@ -265,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."
@@ -298,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
@@ -315,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
@@ -334,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."
@@ -439,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))
@@ -453,7 +481,9 @@ and does not employ any heuristic at all."
   "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))
@@ -462,8 +492,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."
-  ;; If rev1 is nil, `diff' uses the current workfile version.
-  (zerop (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.
@@ -589,10 +632,17 @@ a regexp for matching all such backup files, regardless of the version."
   "Make a backup copy of FILE, which is assumed in sync with the repository.
 Before doing that, check if there are any old backups and get rid of them."
   (unless (and (fboundp 'msdos-long-file-names)
-               (not (with-no-warnings 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)."
@@ -698,6 +748,9 @@ current, and kill the buffer that visits the link."
       (set-buffer true-buffer)
       (kill-buffer this-buffer))))
 
+(defun vc-default-find-file-hook (backend)
+  nil)
+
 (defun vc-find-file-hook ()
   "Function for `find-file-hook' activating VC mode if appropriate."
   ;; Recompute whether file is version controlled,
@@ -713,9 +766,11 @@ current, and kill the buffer that visits the link."
       (unless vc-make-backup-files
        ;; Use this variable, not make-backup-files,
        ;; because this is for things that depend on the file name.
-       (set (make-local-variable 'backup-inhibited) t)))
-     ((let* ((link (file-symlink-p buffer-file-name))
-            (link-type (and link (vc-backend (file-chase-links 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-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
@@ -752,14 +807,17 @@ Used in `find-file-not-found-functions'."
   ;; When a file does not exist, ignore cached info about it
   ;; from a previous visit.
   (vc-file-clearprops buffer-file-name)
-  (if (and (vc-backend buffer-file-name)
-          (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))))))
+  (let ((backend (vc-backend buffer-file-name)))
+    (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
+       (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))))))
 
 (add-hook 'find-file-not-found-functions 'vc-file-not-found-hook)
 
@@ -848,4 +906,5 @@ Used in `find-file-not-found-functions'."
 
 (provide 'vc-hooks)
 
+;; arch-tag: 2e5a6fa7-1d30-48e2-8bd0-e3d335f04f32
 ;;; vc-hooks.el ends here