;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
-;; $Id: vc-hooks.el,v 1.53 2000/08/13 11:36:46 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 'cl))
+
;; Customization Variables (the rest is in vc.el)
(defvar vc-ignore-vc-files nil "Obsolete -- use `vc-handled-backends'.")
when visiting a file managed by that backend.
An empty list disables VC altogether."
:type '(repeat symbol)
- :version "20.5"
+ :version "21.1"
:group 'vc)
(defcustom vc-path
(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)
+ `(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
;; them when the file is initially found, keep them up to date
;; during any subsequent VC operations, and forget them when
;; the buffer is killed.
-(defmacro vc-error-occurred (&rest body)
- (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
-
-(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)
+
(defun vc-file-setprop (file property value)
"Set per-file VC PROPERTY for FILE to VALUE."
+ (if (and vc-touched-properties
+ (not (memq property vc-touched-properties)))
+ (setq vc-touched-properties (append (list property)
+ vc-touched-properties)))
(put (intern file vc-file-prop-obarray) property value))
(defun vc-file-getprop (file property)
- "get per-file VC PROPERTY for FILE."
+ "Get per-file VC PROPERTY for FILE."
(get (intern file vc-file-prop-obarray) property))
(defun vc-file-clearprops (file)
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 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)
- (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)))
;; 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))))
(symbol-name (vc-backend file)))
(defun vc-name (file)
- "Return the master name of FILE. 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
+ "Return the master name of FILE.
+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.
(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'."
(eq (vc-state file) 'up-to-date))
(defun vc-default-state-heuristic (backend file)
- "Default implementation of vc-state-heuristic. It simply calls the
-real state computation function `vc-BACKEND-state' and does not employ
-any heuristic at all."
+ "Default implementation of vc-state-heuristic.
+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."
(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
(let ((dirname (or (file-name-directory file) ""))
(basename (file-name-nondirectory file)))
(catch 'found
- (mapcar
+ (mapcar
(lambda (s)
(let ((trial (vc-possible-master s dirname basename)))
(if (and trial (file-exists-p trial)
(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 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 (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,
+ ;; 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)))
(eq (vc-checkout-model file) 'implicit)
(vc-file-setprop file 'vc-state 'edited)
(vc-mode-line file)
- (vc-dired-resynch-file file))))
+ (if (featurep 'vc)
+ ;; If VC is not loaded, then there can't be
+ ;; any VC Dired buffer to synchronize.
+ (vc-dired-resynch-file file)))))
(defun vc-mode-line (file)
"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)))))
+ (interactive (list buffer-file-name))
+ (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)))))
;; 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.
\"BACKEND-REV\" if the file is up-to-date
\"BACKEND:REV\" if the file is edited (or locked by the calling user)
\"BACKEND:LOCKER:REV\" if the file is locked by somebody else
- \"BACKEND @@\" for a CVS file that is added, but not yet committed
This function assumes that the file is registered."
(setq backend (symbol-name backend))
(let ((state (vc-state file))
(rev (vc-workfile-version file)))
- (cond ((string= "0" rev)
- ;; CVS special case; should go into a CVS-specific implementation
- (concat backend " @@"))
- ((or (eq state 'up-to-date)
+ (cond ((or (eq state 'up-to-date)
(eq state 'needs-patch))
(concat backend "-" rev))
((stringp state)
"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
;; it again. GUD does that, and repeated questions
;; are painful.
(get-file-buffer
- (abbreviate-file-name
+ (abbreviate-file-name
(file-chase-links buffer-file-name))))
(vc-follow-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.
;; from a previous visit.
(vc-file-clearprops buffer-file-name)
(if (and (vc-backend buffer-file-name)
- (yes-or-no-p
+ (yes-or-no-p
(format "File %s was lost; check out from version control? "
(file-name-nondirectory buffer-file-name))))
(save-excursion
(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)
HCoop / bpt / emacs.git / blobdiff