;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
-;; $Id: vc-hooks.el,v 1.116 2000/09/04 19:47:25 gerd Exp $
+;; $Id: vc-hooks.el,v 1.128 2000/11/06 13:19:38 monnier Exp $
;; This file is part of GNU Emacs.
;;; Code:
-(eval-when-compile
- (require 'vc))
+;(eval-when-compile
+; (require 'vc))
;; 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))))
(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)
(defun vc-state (file)
"Return the version control state of FILE.
-The value returned is one of:
+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.
(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-version (file)
(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)
(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,
+ ;; 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)))
"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)
;; 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)
;; 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