;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
-;; $Id: vc-hooks.el,v 1.119 2000/09/12 13:00:30 fx Exp $
+;; $Id: vc-hooks.el,v 1.130 2000/11/20 14:01:18 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)
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. 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)))
+ (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)
+ (not (re-search-forward limit nil 'move)))))))
+ (set-buffer-modified-p nil)
+ t))
;;; Access functions to file properties
;;; (Properties should be _set_ using vc-file-setprop, but
(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))))
(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."
+ 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."
+ (mapcar
+ (lambda (f)
+ (delete-file f))
+ (directory-files (file-name-directory file) t
+ (vc-version-backup-file-name file nil nil t))))
+
+(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,
"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))
+ (interactive (list buffer-file-name))
(unless (not (vc-backend file))
(setq vc-mode (concat " " (if vc-display-status
(vc-call mode-line-string file)