;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
-;; $Id: vc-hooks.el,v 1.127 2000/11/04 18:24:50 spiegel Exp $
+;; $Id: vc-hooks.el,v 1.144 2002/09/04 20:45:34 spiegel Exp $
;; This file is part of GNU Emacs.
;;; Code:
-;(eval-when-compile
-; (require 'vc))
+(eval-when-compile
+ (require 'cl))
;; Customization Variables (the rest is in vc.el)
(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
;; 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)
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 non-nil if FILE
-exists and its contents were successfully inserted."
+occurrence of LIMIT is found. Anything from the start of that occurence
+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)
(when (file-exists-p file)
(if (not limit)
(and (< 0 (cadr (insert-file-contents
file nil filepos (incf filepos blocksize))))
(progn (beginning-of-line)
- (not (re-search-forward limit nil 'move)))))))
+ (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.)
+;; 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
+;; properties indicating the backend being used for FILE
(defun vc-registered (file)
"Return non-nil if FILE is registered in a version control system.
(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.
(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.
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'."
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."
(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
(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-p (backend file)
- "Return non-nil if unmodified repository versions should
-be backed up locally. The default is to switch off this feature."
+ "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)
(defun vc-delete-automatic-version-backups (file)
"Delete all existing automatic version backups for FILE."
- (mapcar
- (lambda (f)
- (delete-file f))
- (directory-files (file-name-directory file) t
- (vc-version-backup-file-name file nil nil t))))
+ (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.
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)))))
"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
(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.
(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))
(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)