X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5eb2b516a6091a66f0de72550c2e5c220862c572..6b61353c0a0320ee15bb6488149735381fed62ec:/lisp/vc-hooks.el diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 624d5f61a8..80b9766caa 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -1,11 +1,12 @@ ;;; vc-hooks.el --- resident support for version-control -;; Copyright (C) 1992,93,94,95,96,98,99,2000 Free Software Foundation, Inc. +;; Copyright (C) 1992,93,94,95,96,98,99,2000,03,2004 +;; Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel -;; $Id: vc-hooks.el,v 1.118 2000/09/06 10:41:10 gerd Exp $ +;; $Id: vc-hooks.el,v 1.165 2004/03/28 17:38:03 monnier Exp $ ;; This file is part of GNU Emacs. @@ -33,16 +34,26 @@ ;;; Code: -;(eval-when-compile -; (require 'vc)) +(eval-when-compile + (require 'cl)) ;; Customization Variables (the rest is in vc.el) -(defvar vc-ignore-vc-files nil "Obsolete -- use `vc-handled-backends'.") -(defvar vc-master-templates () "Obsolete -- use vc-BACKEND-master-templates.") -(defvar vc-header-alist () "Obsolete -- use vc-BACKEND-header.") +(defvar vc-ignore-vc-files nil) +(make-obsolete-variable 'vc-ignore-vc-files + "set `vc-handled-backends' to nil to disable VC.") -(defcustom vc-handled-backends '(RCS CVS SCCS) +(defvar vc-master-templates ()) +(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 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. @@ -65,7 +76,8 @@ An empty list disables VC altogether." "*If non-nil, backups of registered files are made as with other files. If nil (the default), files covered by version control don't get backups." :type 'boolean - :group 'vc) + :group 'vc + :group 'backup) (defcustom vc-follow-symlinks 'ask "*What to do if visiting a symbolic link to a file under version control. @@ -114,14 +126,72 @@ See also variable `vc-consult-headers'." (funcall vc-mistrust-permissions (vc-backend-subdirectory-name file))))) +(defcustom vc-stay-local t + "*Non-nil means use local operations when possible for remote repositories. +This avoids slow queries over the network and instead uses heuristics +and past information to determine the current status of a file. + +The value can also be a regular expression or list of regular +expressions to match against the host name of a repository; then VC +only stays local for hosts that match it. Alternatively, the value +can be a list of regular expressions where the first element is the +symbol `except'; then VC always stays local except for hosts matched +by these regular expressions." + :type '(choice (const :tag "Always stay local" t) + (const :tag "Don't stay local" nil) + (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." + (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" + :group 'vc) + +(defun vc-stay-local-p (file) + "Return non-nil if VC should stay local when handling FILE. +This uses the `repository-hostname' backend operation." + (let* ((backend (vc-backend file)) + (sym (vc-make-backend-sym backend 'stay-local)) + (stay-local (if (boundp sym) (symbol-value sym) t))) + (if (eq stay-local t) (setq stay-local vc-stay-local)) + (if (symbolp stay-local) stay-local + (let ((dirname (if (file-directory-p file) + (directory-file-name file) + (file-name-directory file)))) + (eq 'yes + (or (vc-file-getprop dirname 'vc-stay-local-p) + (vc-file-setprop + dirname 'vc-stay-local-p + (let ((hostname (vc-call-backend + backend 'repository-hostname dirname))) + (if (not hostname) + 'no + (let ((default t)) + (if (eq (car-safe stay-local) 'except) + (setq default nil stay-local (cdr stay-local))) + (when (consp stay-local) + (setq stay-local + (mapconcat 'identity stay-local "\\|"))) + (if (if (string-match stay-local hostname) + default (not default)) + 'yes 'no))))))))))) + +;;; This is handled specially now. ;; Tell Emacs about this new kind of minor mode -(add-to-list 'minor-mode-alist '(vc-mode vc-mode)) +;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode)) (make-variable-buffer-local 'vc-mode) (put 'vc-mode 'permanent-local t) +(defun vc-mode (&optional arg) + ;; Dummy function for C-h m + "Version Control minor mode. +This minor mode is automatically activated whenever you visit a file under +control of one of the revision control systems in `vc-handled-backends'. +VC commands are globally reachable under the prefix `\\[vc-prefix-map]': +\\{vc-prefix-map}") + (defmacro vc-error-occurred (&rest body) - (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t))) + `(condition-case nil (progn ,@body nil) (error t))) ;; We need a notion of per-file properties because the version ;; control state of a file is expensive to derive --- we compute @@ -129,7 +199,7 @@ See also variable `vc-consult-headers'." ;; during any subsequent VC operations, and forget them when ;; the buffer is killed. -(defvar vc-file-prop-obarray (make-vector 16 0) +(defvar vc-file-prop-obarray (make-vector 17 0) "Obarray for per-file properties.") (defvar vc-touched-properties nil) @@ -161,7 +231,7 @@ See also variable `vc-consult-headers'." (defun vc-find-backend-function (backend fun) "Return BACKEND-specific implementation of FUN. -If there is no such implementation, return the default implementation; +If there is no such implementation, return the default implementation; if that doesn't exist either, return nil." (let ((f (vc-make-backend-sym backend fun))) (if (fboundp f) f @@ -183,19 +253,19 @@ and else calls (apply 'vc-default-FUN BACKEND ARGS) It is usually called via the `vc-call' macro." - (let ((f (cdr (assoc function-name (get backend 'vc-functions))))) - (unless f + (let ((f (assoc function-name (get backend 'vc-functions)))) + (if f (setq f (cdr f)) (setq f (vc-find-backend-function backend function-name)) - (put backend 'vc-functions (cons (cons function-name f) - (get backend 'vc-functions)))) - (if (consp f) - (apply (car f) (cdr f) args) - (apply f args)))) + (push (cons function-name f) (get backend 'vc-functions))) + (cond + ((null f) + (error "Sorry, %s is not implemented for %s" function-name backend)) + ((consp f) (apply (car f) (cdr f) args)) + (t (apply f args))))) (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." @@ -208,42 +278,42 @@ It is usually called via the `vc-call' macro." Optional argument LIMIT is a regexp. If present, the file is inserted in chunks of size BLOCKSIZE (default 8 kByte), until the first -occurrence of LIMIT is found. The function returns nil if FILE doesn't -exist." +occurrence of LIMIT is found. Anything from the start of that occurrence +to the end of the buffer is then deleted. The function returns +non-nil if FILE exists and its contents were successfully inserted." (erase-buffer) - (cond ((file-exists-p file) - (cond (limit - (if (not blocksize) (setq blocksize 8192)) - (let (found s) - (while (not found) - (setq s (buffer-size)) - (goto-char (1+ s)) - (setq found - (or (zerop (cadr (insert-file-contents - file nil s (+ s blocksize)))) - (progn (beginning-of-line) - (re-search-forward limit nil t))))))) - (t (insert-file-contents file))) - (set-buffer-modified-p nil) - (auto-save-mode nil) - t) - (t nil))) - -;;; Access functions to file properties -;;; (Properties should be _set_ using vc-file-setprop, but -;;; _retrieved_ only through these functions, which decide -;;; if the property is already known or not. A property should -;;; only be retrieved by vc-file-getprop if there is no -;;; access function.) - -;;; properties indicating the backend being used for FILE + (when (file-exists-p file) + (if (not limit) + (insert-file-contents file) + (if (not blocksize) (setq blocksize 8192)) + (let ((filepos 0)) + (while + (and (< 0 (cadr (insert-file-contents + file nil filepos (incf filepos blocksize)))) + (progn (beginning-of-line) + (let ((pos (re-search-forward limit nil 'move))) + (if pos (delete-region (match-beginning 0) + (point-max))) + (not pos))))))) + (set-buffer-modified-p nil) + t)) + +;; Access functions to file properties +;; (Properties should be _set_ using vc-file-setprop, but +;; _retrieved_ only through these functions, which decide +;; if the property is already known or not. A property should +;; only be retrieved by vc-file-getprop if there is no +;; access function.) + +;; properties indicating the backend being used for FILE (defun vc-registered (file) "Return non-nil if FILE is registered in a version control system. -This function does not cache its result; it performs the test each -time it is invoked on a file. For a caching check whether a file is -registered, use `vc-backend'." +This function performs the check each time it is called. To rely +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))) @@ -253,13 +323,15 @@ registered, use `vc-backend'." ;; There is no file name handler. ;; Try vc-BACKEND-registered for each handled BACKEND. (catch 'found - (mapcar - (lambda (b) - (and (vc-call-backend b 'registered file) - (vc-file-setprop file 'vc-backend b) - (throw 'found t))) - (unless vc-ignore-vc-files - vc-handled-backends)) + (let ((backend (vc-file-getprop file 'vc-backend))) + (mapcar + (lambda (b) + (and (vc-call-backend b 'registered file) + (vc-file-setprop file 'vc-backend b) + (throw 'found t))) + (if (or (not backend) (eq backend 'none)) + vc-handled-backends + (cons backend vc-handled-backends)))) ;; File is not registered. (vc-file-setprop file 'vc-backend 'none) nil)))) @@ -267,7 +339,7 @@ registered, use `vc-backend'." (defun vc-backend (file) "Return the version control type of FILE, nil if it is not registered." ;; `file' can be nil in several places (typically due to the use of - ;; code like (vc-backend (buffer-file-name))). + ;; code like (vc-backend buffer-file-name)). (when (stringp file) (let ((property (vc-file-getprop file 'vc-backend))) ;; Note that internally, Emacs remembers unregistered @@ -289,27 +361,32 @@ If the file is not registered, or the master name is not known, return nil." ;; TODO: This should ultimately become obsolete, at least up here ;; in vc-hooks. (or (vc-file-getprop file 'vc-name) - (if (vc-backend file) + ;; force computation of the property by calling + ;; vc-BACKEND-registered explicitly + (if (and (vc-backend file) + (vc-call-backend (vc-backend file) 'registered file)) (vc-file-getprop file 'vc-name)))) (defun vc-checkout-model (file) "Indicate how FILE is checked out. -Possible values: +If FILE is not registered, this function always returns nil. +For registered files, the possible values are: - 'implicit File is always writeable, and checked out `implicitly' + 'implicit FILE is always writeable, and checked out `implicitly' when the user saves the first changes to the file. - 'locking File is read-only if up-to-date; user must type - \\[vc-toggle-read-only] before editing. Strict locking + 'locking FILE is read-only if up-to-date; user must type + \\[vc-next-action] before editing. Strict locking is assumed. - 'announce File is read-only if up-to-date; user must type - \\[vc-toggle-read-only] before editing. But other users + 'announce FILE is read-only if up-to-date; user must type + \\[vc-next-action] before editing. But other users may be editing at the same time." (or (vc-file-getprop file 'vc-checkout-model) - (vc-file-setprop file 'vc-checkout-model - (vc-call checkout-model file)))) + (if (vc-backend file) + (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. @@ -323,7 +400,8 @@ UID is returned as a string." (defun vc-state (file) "Return the version control state of FILE. -The value returned is one of: +If FILE is not registered, this function always returns nil. +For registered files, the value returned is one of: 'up-to-date The working file is unmodified with respect to the latest version on the current branch, and not locked. @@ -334,7 +412,7 @@ The value returned is one of: USER The current version of the working file is locked by some other USER (a string). - + 'needs-patch The file has not been edited by the user, but there is a more recent version on the current branch stored in the master file. @@ -350,9 +428,16 @@ The value returned is one of: with locking; it represents an erroneous condition that should be resolved by the user (vc-next-action will prompt the user to do it)." + ;; FIXME: New (sub)states needed (?): + ;; - `added' (i.e. `edited' but with no base version yet, + ;; typically represented by vc-workfile-version = "0") + ;; - `conflict' (i.e. `edited' with conflict markers) + ;; - `removed' + ;; - `copied' and `moved' (might be handled by `removed' and `added') (or (vc-file-getprop file 'vc-state) - (vc-file-setprop file 'vc-state - (vc-call state-heuristic file)))) + (if (vc-backend file) + (vc-file-setprop file 'vc-state + (vc-call state-heuristic file))))) (defsubst vc-up-to-date-p (file) "Convenience function that checks whether `vc-state' of FILE is `up-to-date'." @@ -364,13 +449,42 @@ It simply calls the real state computation function `vc-BACKEND-state' and does not employ any heuristic at all." (vc-call-backend backend 'state file)) +(defun vc-workfile-unchanged-p (file) + "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 + (equal checkout-time lastmod) + (let ((unchanged (vc-call workfile-unchanged-p file))) + (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) + unchanged)))) + +(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." + (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) 5))) + (signal wrong-number-of-arguments err) + (vc-call diff file)))))) + (defun vc-workfile-version (file) - "Return version level of the current workfile FILE." + "Return the version level of the current workfile FILE. +If FILE is not registered, this function always returns nil." (or (vc-file-getprop file 'vc-workfile-version) - (vc-file-setprop file 'vc-workfile-version - (vc-call workfile-version file)))) - -;;; actual version-control code starts here + (if (vc-backend file) + (vc-file-setprop file 'vc-workfile-version + (vc-call workfile-version file))))) (defun vc-default-registered (backend file) "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates." @@ -383,7 +497,8 @@ and does not employ any heuristic at all." (and (consp template) (eq (cdr template) backend) (car template))) - vc-master-templates)) + (with-no-warnings + vc-master-templates))) (symbol-value sym)))) (let ((result (vc-check-master-templates file (symbol-value sym)))) (if (stringp result) @@ -403,8 +518,7 @@ and does not employ any heuristic at all." (if (consp result) (car result) result))))) (defun vc-check-master-templates (file templates) - "Return non-nil if there is a master corresponding to FILE, -according to any of the elements in TEMPLATES. + "Return non-nil if there is a master corresponding to FILE. TEMPLATES is a list of strings or functions. If an element is a string, it must be a control string as required by `format', with two @@ -439,26 +553,78 @@ this function." (defun vc-toggle-read-only (&optional verbose) "Change read-only status of current buffer, perhaps via version control. + If the buffer is visiting a file registered with version control, then check the file in or out. Otherwise, just change the read-only flag of the buffer. With prefix argument, ask for version number to check in or check out. Check-out of a specified version number does not lock the file; -to do that, use this command a second time with no argument." +to do that, use this command a second time with no argument. + +If you bind this function to \\[toggle-read-only], then Emacs checks files +in or out whenever you toggle the read-only flag." (interactive "P") (if (or (and (boundp 'vc-dired-mode) vc-dired-mode) ;; use boundp because vc.el might not be loaded - (vc-backend (buffer-file-name))) + (vc-backend buffer-file-name)) (vc-next-action verbose) (toggle-read-only))) -(define-key global-map "\C-x\C-q" 'vc-toggle-read-only) + +(defun vc-default-make-version-backups-p (backend file) + "Return non-nil if unmodified versions should be backed up locally. +The default is to switch off this feature." + nil) + +(defun vc-version-backup-file-name (file &optional rev manual regexp) + "Return a backup file name for REV or the current version of FILE. +If MANUAL is non-nil it means that a name for backups created by +the user should be returned; if REGEXP is non-nil that means to return +a regexp for matching all such backup files, regardless of the version." + (if regexp + (concat (regexp-quote (file-name-nondirectory file)) + "\\.~[0-9.]+" (unless manual "\\.") "~") + (expand-file-name (concat (file-name-nondirectory file) + ".~" (or rev (vc-workfile-version file)) + (unless manual ".") "~") + (file-name-directory file)))) + +(defun vc-delete-automatic-version-backups (file) + "Delete all existing automatic version backups for FILE." + (condition-case nil + (mapcar + 'delete-file + (directory-files (or (file-name-directory file) default-directory) t + (vc-version-backup-file-name file nil nil t))) + ;; Don't fail when the directory doesn't exist. + (file-error nil))) + +(defun vc-make-version-backup (file) + "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)))) + (vc-delete-automatic-version-backups file) + (copy-file file (vc-version-backup-file-name file) + nil 'keep-date))) + +(defun vc-before-save () + "Function to be called by `basic-save-buffer' (in files.el)." + ;; If the file on disk is still in sync with the repository, + ;; 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)))) (defun vc-after-save () "Function to be called by `basic-save-buffer' (in files.el)." ;; If the file in the current buffer is under version control, ;; up-to-date, and locking is not used for the file, set ;; the state to 'edited and redisplay the mode line. - (let ((file (buffer-file-name))) + (let ((file buffer-file-name)) (and (vc-backend file) (or (and (equal (vc-file-getprop file 'vc-checkout-time) (nth 5 (file-attributes file))) @@ -480,28 +646,30 @@ to do that, use this command a second time with no argument." "Set `vc-mode' to display type of version control for FILE. The value is set in the current buffer, which should be the buffer visiting FILE." - (interactive (list buffer-file-name nil)) - (unless (not (vc-backend file)) - (setq vc-mode (concat " " (if vc-display-status - (vc-call mode-line-string file) - (symbol-name (vc-backend file))))) - ;; If the file is locked by some other user, make - ;; the buffer read-only. Like this, even root - ;; cannot modify a file that someone else has locked. - (and (equal file (buffer-file-name)) - (stringp (vc-state file)) - (setq buffer-read-only t)) - ;; If the user is root, and the file is not owner-writable, - ;; then pretend that we can't write it - ;; even though we can (because root can write anything). + (interactive (list buffer-file-name)) + (let ((backend (vc-backend file))) + (if (not backend) + (setq vc-mode nil) + (setq vc-mode (concat " " (if vc-display-status + (vc-call mode-line-string file) + (symbol-name backend)))) + ;; If the file is locked by some other user, make + ;; the buffer read-only. Like this, even root + ;; cannot modify a file that someone else has locked. + (and (equal file buffer-file-name) + (stringp (vc-state file)) + (setq buffer-read-only t)) + ;; If the user is root, and the file is not owner-writable, + ;; then pretend that we can't write it + ;; even though we can (because root can write anything). ;; This way, even root cannot modify a file that isn't locked. - (and (equal file (buffer-file-name)) + (and (equal file buffer-file-name) (not buffer-read-only) - (zerop (user-real-uid)) - (zerop (logand (file-modes (buffer-file-name)) 128)) - (setq buffer-read-only t))) - (force-mode-line-update) - (vc-backend file)) + (zerop (user-real-uid)) + (zerop (logand (file-modes buffer-file-name) 128)) + (setq buffer-read-only t))) + (force-mode-line-update) + backend)) (defun vc-default-mode-line-string (backend file) "Return string for placement in modeline by `vc-mode-line' for FILE. @@ -543,82 +711,112 @@ 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-hooks' activating VC mode if appropriate." + "Function for `find-file-hook' activating VC mode if appropriate." ;; Recompute whether file is version controlled, ;; if user has killed the buffer and revisited. + (if vc-mode + (setq vc-mode nil)) (when buffer-file-name (vc-file-clearprops buffer-file-name) (cond ((vc-backend buffer-file-name) + ;; Compute the state and put it in the modeline. (vc-mode-line buffer-file-name) - (cond ((not vc-make-backup-files) - ;; Use this variable, not make-backup-files, - ;; because this is for things that depend on the file name. - (make-local-variable 'backup-inhibited) - (setq backup-inhibited t)))) + (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 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))))) - (if link-type - (cond ((eq vc-follow-symlinks nil) - (message + (cond ((not link-type) nil) ;Nothing to do. + ((eq vc-follow-symlinks nil) + (message "Warning: symbolic link to %s-controlled source file" link-type)) - ((or (not (eq vc-follow-symlinks 'ask)) - ;; If we already visited this file by following - ;; the link, don't ask again if we try to visit - ;; it again. GUD does that, and repeated questions - ;; are painful. - (get-file-buffer - (abbreviate-file-name - (file-chase-links buffer-file-name)))) - - (vc-follow-link) - (message "Followed link to %s" buffer-file-name) - (vc-find-file-hook)) - (t - (if (yes-or-no-p (format + ((or (not (eq vc-follow-symlinks 'ask)) + ;; If we already visited this file by following + ;; the link, don't ask again if we try to visit + ;; it again. GUD does that, and repeated questions + ;; are painful. + (get-file-buffer + (abbreviate-file-name + (file-chase-links buffer-file-name)))) + + (vc-follow-link) + (message "Followed link to %s" buffer-file-name) + (vc-find-file-hook)) + (t + (if (yes-or-no-p (format "Symbolic link to %s-controlled source file; follow link? " link-type)) - (progn (vc-follow-link) - (message "Followed link to %s" buffer-file-name) - (vc-find-file-hook)) - (message + (progn (vc-follow-link) + (message "Followed link to %s" buffer-file-name) + (vc-find-file-hook)) + (message "Warning: editing through the link bypasses version control") - ))))))))) + )))))))) -(add-hook 'find-file-hooks 'vc-find-file-hook) +(add-hook 'find-file-hook 'vc-find-file-hook) -;;; more hooks, this time for file-not-found +;; more hooks, this time for file-not-found (defun vc-file-not-found-hook () "When file is not found, try to check it out from version control. Returns t if checkout was successful, nil otherwise. -Used in `find-file-not-found-hooks'." +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-hooks 'vc-file-not-found-hook) +(add-hook 'find-file-not-found-functions 'vc-file-not-found-hook) (defun vc-kill-buffer-hook () "Discard VC info about a file when we kill its buffer." - (if (buffer-file-name) - (vc-file-clearprops (buffer-file-name)))) - -;; ??? DL: why is this not done? -;;;(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook) - -;;; Now arrange for bindings and autoloading of the main package. -;;; Bindings for this have to go in the global map, as we'll often -;;; want to call them from random buffers. - -(autoload 'vc-prefix-map "vc" nil nil 'keymap) + (if buffer-file-name + (vc-file-clearprops buffer-file-name))) + +(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook) + +;; Now arrange for (autoloaded) bindings of the main package. +;; Bindings for this have to go in the global map, as we'll often +;; want to call them from random buffers. + +;; Autoloading works fine, but it prevents shortcuts from appearing +;; in the menu because they don't exist yet when the menu is built. +;; (autoload 'vc-prefix-map "vc" nil nil 'keymap) +(defvar vc-prefix-map + (let ((map (make-sparse-keymap))) + (define-key map "a" 'vc-update-change-log) + (define-key map "b" 'vc-switch-backend) + (define-key map "c" 'vc-cancel-version) + (define-key map "d" 'vc-directory) + (define-key map "g" 'vc-annotate) + (define-key map "h" 'vc-insert-headers) + (define-key map "i" 'vc-register) + (define-key map "l" 'vc-print-log) + (define-key map "m" 'vc-merge) + (define-key map "r" 'vc-retrieve-snapshot) + (define-key map "s" 'vc-create-snapshot) + (define-key map "u" 'vc-revert-buffer) + (define-key map "v" 'vc-next-action) + (define-key map "=" 'vc-diff) + (define-key map "~" 'vc-version-other-window) + map)) +(fset 'vc-prefix-map vc-prefix-map) (define-key global-map "\C-xv" 'vc-prefix-map) (if (not (boundp 'vc-menu-map)) @@ -637,36 +835,39 @@ Used in `find-file-not-found-hooks'." (define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file)) (define-key vc-menu-map [vc-version-other-window] '("Show Other Version" . vc-version-other-window)) - (define-key vc-menu-map [vc-diff] '("Compare with Last Version" . vc-diff)) + (define-key vc-menu-map [vc-diff] '("Compare with Base Version" . vc-diff)) (define-key vc-menu-map [vc-update-change-log] '("Update ChangeLog" . vc-update-change-log)) (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log)) (define-key vc-menu-map [separator2] '("----")) - (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version)) - (define-key vc-menu-map [vc-revert-buffer] - '("Revert to Last Version" . vc-revert-buffer)) (define-key vc-menu-map [vc-insert-header] '("Insert Header" . vc-insert-headers)) + (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version)) + (define-key vc-menu-map [vc-revert-buffer] + '("Revert to Base Version" . vc-revert-buffer)) + (define-key vc-menu-map [vc-update] + '("Update to Latest Version" . vc-update)) (define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action)) (define-key vc-menu-map [vc-register] '("Register" . vc-register))) -;;; These are not correct and it's not currently clear how doing it -;;; better (with more complicated expressions) might slow things down -;;; on older systems. - -;;;(put 'vc-rename-file 'menu-enable 'vc-mode) -;;;(put 'vc-annotate 'menu-enable '(eq (vc-buffer-backend) 'CVS)) -;;;(put 'vc-version-other-window 'menu-enable 'vc-mode) -;;;(put 'vc-diff 'menu-enable 'vc-mode) -;;;(put 'vc-update-change-log 'menu-enable -;;; '(member (vc-buffer-backend) '(RCS CVS))) -;;;(put 'vc-print-log 'menu-enable 'vc-mode) -;;;(put 'vc-cancel-version 'menu-enable 'vc-mode) -;;;(put 'vc-revert-buffer 'menu-enable 'vc-mode) -;;;(put 'vc-insert-headers 'menu-enable 'vc-mode) -;;;(put 'vc-next-action 'menu-enable 'vc-mode) -;;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode))) +;; These are not correct and it's not currently clear how doing it +;; better (with more complicated expressions) might slow things down +;; on older systems. + +;;(put 'vc-rename-file 'menu-enable 'vc-mode) +;;(put 'vc-annotate 'menu-enable '(eq (vc-buffer-backend) 'CVS)) +;;(put 'vc-version-other-window 'menu-enable 'vc-mode) +;;(put 'vc-diff 'menu-enable 'vc-mode) +;;(put 'vc-update-change-log 'menu-enable +;; '(member (vc-buffer-backend) '(RCS CVS))) +;;(put 'vc-print-log 'menu-enable 'vc-mode) +;;(put 'vc-cancel-version 'menu-enable 'vc-mode) +;;(put 'vc-revert-buffer 'menu-enable 'vc-mode) +;;(put 'vc-insert-headers 'menu-enable 'vc-mode) +;;(put 'vc-next-action 'menu-enable 'vc-mode) +;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode))) (provide 'vc-hooks) +;;; arch-tag: 2e5a6fa7-1d30-48e2-8bd0-e3d335f04f32 ;;; vc-hooks.el ends here