X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ab5796a9f97180707734a81320e3eb81937281fe..5ca75c83ef58d012acef2a4bea01281cc5c0fa89:/lisp/vc-hooks.el diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index c9603d68e2..2dc8e1533f 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -1,12 +1,12 @@ ;;; vc-hooks.el --- resident support for version-control -;; Copyright (C) 1992,93,94,95,96,98,99,2000,2003 +;; 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 -;; $Id: vc-hooks.el,v 1.159 2003/08/30 10:56:38 eliz Exp $ +;; $Id$ ;; This file is part of GNU Emacs. @@ -44,15 +44,22 @@ "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) -(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. @@ -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)) - (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)) @@ -462,8 +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." - ;; 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. @@ -698,6 +739,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 +757,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 +798,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,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