X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/67c6f446df01c638d42620d498100995bb86ccaf..beb402deed11deee9fdaddb986cc7c51c14082d0:/lisp/vc-hooks.el diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index af08aa6a7d..d57ec54f46 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -5,7 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel -;; $Id: vc-hooks.el,v 1.122 2000/10/04 09:50:21 spiegel Exp $ +;; $Id: vc-hooks.el,v 1.146 2002/10/17 15:46:06 lektu Exp $ ;; This file is part of GNU Emacs. @@ -33,14 +33,17 @@ ;;; 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 'vc-handled-backends) +(defvar vc-master-templates ()) +(make-obsolete-variable 'vc-master-templates 'vc-BACKEND-master-templates) +(defvar vc-header-alist ()) +(make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header) (defcustom vc-handled-backends '(RCS CVS SCCS) "*List of version control backends for which VC will be used. @@ -114,14 +117,23 @@ See also variable `vc-consult-headers'." (funcall vc-mistrust-permissions (vc-backend-subdirectory-name file))))) +;;; 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 +141,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 +173,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 @@ -208,35 +220,34 @@ 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. @@ -260,7 +271,7 @@ backend is tried first." (and (vc-call-backend b 'registered file) (vc-file-setprop file 'vc-backend b) (throw 'found t))) - (if (or (not backend) (eq backend 'none)) + (if (or (not backend) (eq backend 'none)) vc-handled-backends (cons backend vc-handled-backends)))) ;; File is not registered. @@ -301,21 +312,23 @@ If the file is not registered, or the master name is not known, return nil." (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. @@ -329,7 +342,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. @@ -340,7 +354,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. @@ -357,8 +371,9 @@ The value returned is one of: should be resolved by the user (vc-next-action will prompt the user to do it)." (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'." @@ -370,13 +385,28 @@ 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 (vc-call diff file (vc-workfile-version 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." @@ -409,8 +439,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 @@ -445,28 +474,59 @@ 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-next-action verbose) (toggle-read-only))) -(define-key global-map "\C-x\C-q" 'vc-toggle-read-only) -(defun vc-default-make-version-backups (backend file) - "Return non-nil if unmodified repository versions should -be backed up locally. The default is to switch off this feature." +(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) - "Return a backup file name for REV or the current version of FILE." - (concat file ".~" (or rev (vc-workfile-version file)) "~")) +(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 (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)." @@ -477,9 +537,8 @@ be backed up locally. The default is to switch off this feature." (and (vc-backend file) (vc-up-to-date-p file) (eq (vc-checkout-model file) 'implicit) - (vc-call make-version-backups file) - (copy-file file (vc-version-backup-file-name file) - 'ok-if-already-exists 'keep-date)))) + (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)." @@ -509,7 +568,8 @@ be backed up locally. The default is to switch off this feature." The value is set in the current buffer, which should be the buffer visiting FILE." (interactive (list buffer-file-name)) - (unless (not (vc-backend file)) + (if (not (vc-backend file)) + (setq vc-mode nil) (setq vc-mode (concat " " (if vc-display-status (vc-call mode-line-string file) (symbol-name (vc-backend file))))) @@ -575,6 +635,8 @@ current, and kill the buffer that visits the link." "Function for `find-file-hooks' 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 @@ -599,7 +661,7 @@ current, and kill the buffer that visits the link." (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)) @@ -615,7 +677,7 @@ current, and kill the buffer that visits the link." (add-hook 'find-file-hooks '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. @@ -639,14 +701,34 @@ Used in `find-file-not-found-hooks'." (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) +(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)) @@ -665,35 +747,37 @@ 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)