;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
-;; $Id: vc-hooks.el,v 1.123 2000/10/05 22:47:21 monnier Exp $
+;; $Id: vc-hooks.el,v 1.146 2002/10/17 15:46:06 lektu 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)
-(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.
(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)
(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
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.
(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.
(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.
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.
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)
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."
- (let ((delim (if manual "~" "#")))
- (if regexp
- (concat (regexp-quote (file-name-nondirectory file))
- "." delim "[0-9.]+" delim)
- (expand-file-name (concat (file-name-nondirectory file)
- "." delim
- (or rev (vc-workfile-version file))
- delim)
- (file-name-directory file)))))
+ (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))))
+ (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."
- (vc-delete-automatic-version-backups file)
- (copy-file file (vc-version-backup-file-name file)
- nil 'keep-date))
+ (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)."
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
(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))
(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)
HCoop / bpt / emacs.git / blobdiff