comparison lisp/vc.el @ 32058:4196f89984ce

* vc.el (vc-editable-p): Minor optimization. (edit-vc-file, vc-next-action-on-file): Don't use find-file. (vc-find-new-backend): New function split from vc-responsible-backend. (vc-register): Use it. (vc-responsible-backend): Remove REGISTER arg and add BACKENDS arg. (vc-unregister): Drop BACKEND arg (it doesn't work anyway). (vc-default-unregister, vc-revert-buffer): Docstring fix. (vc-clear-headers): Don't use find-file. (vc-revert-buffer): Use `and' again (must have been a braino). (vc-switch-backend): Only prompt if requested. (vc-default-receive-file): Update call to vc-unregister. * vc-rcs.el (vc-rcs-unregister): Keep a backup of the master file. (vc-rcs-receive-file): Avoid with-vc-properties. Update call to vc-unregister. Use constant `RCS' rather than (dynamically bound) var `backend'.

32057:acd9a3daf12b

;;     Only required if `annotate-command' is defined for the backend.

(require 'vc-hooks)
(require 'ring)
(eval-when-compile
  (require 'compile)
  (require 'dired)      ; for dired-map-over-marks macro
  (require 'dired-aux))	; for dired-kill-{line,tree}

(if (not (assoc 'vc-parent-buffer minor-mode-alist))

;; Random helper functions

(defsubst vc-editable-p (file)
  (or (eq (vc-checkout-model file) 'implicit)
      (eq (vc-state file) 'edited)
      (eq (vc-state file) 'needs-merge)))

;;; Two macros for elisp programming
;;;###autoload
(defmacro with-vc-file (file comment &rest body)
  "Check out a writable copy of FILE if necessary and execute the body.

Checkin with COMMENT after executing BODY.
This macro uses `with-vc-file', passing args to it.
However, before executing BODY, find FILE, and after BODY, save buffer."
  `(with-vc-file
    ,file ,comment
    (find-file ,file)
    ,@body
    (save-buffer)))

(defun vc-ensure-vc-buffer ()
  "Make sure that the current buffer visits a version-controlled file."

      ;; Check relation of buffer and file, and make sure
      ;; user knows what he's doing.  First, finding the file
      ;; will check whether the file on disk is newer.
      (if vc-dired-mode
	  (find-file-other-window file)
	(find-file file))
      (if (not (verify-visited-file-modtime (current-buffer)))
	  (if (yes-or-no-p "Replace file on disk with buffer contents? ")
	      (write-file (buffer-file-name))
	    (error "Aborted"))
	;; Now, check if we have unsaved changes.

                  (or comment (not vc-initial-comment))
		  nil
                  "Enter initial comment."
		  (lambda (file rev comment)
		    (message "Registering %s... " file)
		    (let ((backend (vc-responsible-backend file)))
		      (vc-file-clearprops file)
		      (vc-call-backend backend 'register file rev comment)
		      (vc-file-setprop file 'vc-backend backend)
		      (unless vc-make-backup-files
			(make-local-variable 'backup-inhibited)
			(setq backup-inhibited t)))
		    (message "Registering %s... done" file))))

(defun vc-responsible-backend (file &optional register)
  "Return the name of the backend system that is responsible for FILE.
If no backend in variable `vc-handled-backends' declares itself
responsible, the first backend in that list will be returned (if optional
arg REGISTER is non-nil, return the first backend that could register the
file).
FILE can also be a directory name (ending with a slash)."
  (if (null vc-handled-backends)
      (error "Cannot register, no backends in `vc-handled-backends'"))
  (or (and (not (file-directory-p file)) (vc-backend file))
      (catch 'found
	(mapcar (lambda (backend)
		  (if (vc-call-backend backend 'responsible-p file)
		      (throw 'found backend)))
		vc-handled-backends)
	(if register
	    (mapcar (lambda (backend)
		      (if (vc-call-backend backend 'could-register file)
			  (throw 'found backend)))
		    vc-handled-backends)
	  (car vc-handled-backends)))))

(defun vc-default-responsible-p (backend file)
  "Indicate whether BACKEND is reponsible for FILE.  
The default is to return nil always."
  nil)

(defun vc-default-could-register (backend file)
  "Return non-nil if BACKEND could be used to register FILE.
The default implementation returns t for all files."
  t)

(defun vc-unregister (file backend)
  "Unregister FILE from version control system BACKEND."
  (vc-call-backend backend 'unregister file)
  (vc-file-clearprops file))

(defun vc-default-unregister (backend file)
  "Default implementation of vc-unregister, signals an error."
  (error "Unregistering files is not supported for %s" backend))

(defun vc-resynch-window (file &optional keep noquery)
  "If FILE is in the current buffer, either revert or unvisit it.
The choice between revert (to see expanded keywords) and unvisit depends on

	      ;; properly.  If it fails, vc-restore-buffer-context
	      ;; will give it a second try.
	      (save-excursion
		(vc-call-backend backend 'clear-headers))
	      (vc-restore-buffer-context context))
	  (find-file filename)
	  (vc-call-backend backend 'clear-headers)
	  (kill-buffer filename)))))

;;;###autoload
(defun vc-merge ()

;;;###autoload
(defun vc-revert-buffer ()
  "Revert the current buffer's file back to the version it was based on.
This asks for confirmation if the buffer contents are not identical
to that version.  Note that for RCS and CVS, this function does not
automatically pick up newer changes found in the master file;
use \\[universal-argument] \\[vc-next-action] to do so."
  (interactive)
  (vc-ensure-vc-buffer)
  (let ((file buffer-file-name)
	;; This operation should always ask for confirmation.
	(vc-suppress-confirm nil)

      (vc-diff nil t)
      (vc-exec-after `(message nil))
      (unwind-protect
	  (if (not (yes-or-no-p "Discard changes? "))
	      (error "Revert canceled"))
	(if (or (window-dedicated-p (selected-window))
		(one-window-p t 'selected-frame))
	    (make-frame-invisible (selected-frame))
	  (delete-window))))
    (set-buffer obuf)
    ;; Do the reverting
    (message "Reverting %s..." file)
    (with-vc-properties

	(vc-resynch-buffer file t t)))
      (message "Version %s has been removed from the master" target))))

;;;autoload
(defun vc-switch-backend (file backend)
  "Make BACKEND the current version control system for FILE.  
FILE must already be registered in BACKEND.  The change is not
permanent, only for the current session.  This function only changes
VC's perspective on FILE, it does not register or unregister it."
  (interactive 
   (list
    buffer-file-name
    (intern (upcase (read-string "Switch to backend: ")))))
  (unless (vc-call-backend backend 'registered file)
    (error "%s is not registered in %s" file backend))
  (vc-file-clearprops file)
  (vc-file-setprop file 'vc-backend backend)
  (vc-resynch-buffer file t t))

of the log entry buffer."
  (let ((old-backend (vc-backend file))
	(rev (vc-workfile-version file))
	(state (vc-state file))
	(comment (and move (vc-call comment-history file))))
    (if move (vc-unregister file old-backend))
    (vc-file-clearprops file)
    (if (not (vc-call-backend backend 'registered file))
	(with-vc-properties 
	 file
	 ;; TODO: If the file was 'edited under the old backend,

32058:4196f89984ce

;;     Only required if `annotate-command' is defined for the backend.

(require 'vc-hooks)
(require 'ring)
(eval-when-compile
  (require 'cl)
  (require 'compile)
  (require 'dired)      ; for dired-map-over-marks macro
  (require 'dired-aux))	; for dired-kill-{line,tree}

(if (not (assoc 'vc-parent-buffer minor-mode-alist))

;; Random helper functions

(defsubst vc-editable-p (file)
  (or (eq (vc-checkout-model file) 'implicit)
      (memq (vc-state file) '(edited needs-merge))))

;;; Two macros for elisp programming
;;;###autoload
(defmacro with-vc-file (file comment &rest body)
  "Check out a writable copy of FILE if necessary and execute the body.

Checkin with COMMENT after executing BODY.
This macro uses `with-vc-file', passing args to it.
However, before executing BODY, find FILE, and after BODY, save buffer."
  `(with-vc-file
    ,file ,comment
    (set-buffer (find-file-noselect ,file))
    ,@body
    (save-buffer)))

(defun vc-ensure-vc-buffer ()
  "Make sure that the current buffer visits a version-controlled file."

      ;; Check relation of buffer and file, and make sure
      ;; user knows what he's doing.  First, finding the file
      ;; will check whether the file on disk is newer.
      (if vc-dired-mode
	  (find-file-other-window file)
	(set-buffer (find-file-noselect file)))
      (if (not (verify-visited-file-modtime (current-buffer)))
	  (if (yes-or-no-p "Replace file on disk with buffer contents? ")
	      (write-file (buffer-file-name))
	    (error "Aborted"))
	;; Now, check if we have unsaved changes.

                  (or comment (not vc-initial-comment))
		  nil
                  "Enter initial comment."
		  (lambda (file rev comment)
		    (message "Registering %s... " file)
		    (let ((backend (vc-find-new-backend file)))
		      (vc-file-clearprops file)
		      (vc-call-backend backend 'register file rev comment)
		      (vc-file-setprop file 'vc-backend backend)
		      (unless vc-make-backup-files
			(make-local-variable 'backup-inhibited)
			(setq backup-inhibited t)))
		    (message "Registering %s... done" file))))

(defun vc-responsible-backend (file &optional backends)
  "Return the name of the backend system that is responsible for FILE.
If no backend in variable `vc-handled-backends' declares itself
responsible, the first backend in that list will be returned.
FILE can also be a directory name (ending with a slash).
If BACKENDS is non-nil it overrides any current backend or
`vc-handled-backends'."
  (or (and (not backends) (not (file-directory-p file)) (vc-backend file))
      (progn
	(unless backends (setq backends vc-handled-backends))
	(unless backends (error "No reponsible backend"))
	(catch 'found
	  (dolist (backend backends)
	    (if (vc-call-backend backend 'responsible-p file)
		(throw 'found backend)))
	  (car backends)))))

(defun vc-find-new-backend (file)
  "Find a new backend to register FILE."
  (let (backends)
    ;; We can't register if it's already registered
    (dolist (backend vc-handled-backends)
      (when (and (not (vc-call-backend backend 'registered file))
		 (vc-call-backend backend 'could-register file))
	(push backend backends)))
    (unless backends
      (error "Cannot register, no appropriate backend in `vc-handled-backends'"))
    (vc-responsible-backend file (nreverse backends))))

(defun vc-default-responsible-p (backend file)
  "Indicate whether BACKEND is reponsible for FILE.  
The default is to return nil always."
  nil)

(defun vc-default-could-register (backend file)
  "Return non-nil if BACKEND could be used to register FILE.
The default implementation returns t for all files."
  t)

(defun vc-unregister (file)
  "Unregister FILE from version control system BACKEND."
  (vc-call unregister file)
  (vc-file-clearprops file))

(defun vc-default-unregister (backend file)
  "Default implementation of `vc-unregister', signals an error."
  (error "Unregistering files is not supported for %s" backend))

(defun vc-resynch-window (file &optional keep noquery)
  "If FILE is in the current buffer, either revert or unvisit it.
The choice between revert (to see expanded keywords) and unvisit depends on

	      ;; properly.  If it fails, vc-restore-buffer-context
	      ;; will give it a second try.
	      (save-excursion
		(vc-call-backend backend 'clear-headers))
	      (vc-restore-buffer-context context))
	  (set-buffer (find-file-noselect filename))
	  (vc-call-backend backend 'clear-headers)
	  (kill-buffer filename)))))

;;;###autoload
(defun vc-merge ()

;;;###autoload
(defun vc-revert-buffer ()
  "Revert the current buffer's file back to the version it was based on.
This asks for confirmation if the buffer contents are not identical
to that version.  This function does not automatically pick up newer
changes found in the master file; use \\[universal-argument] \\[vc-next-action] to do so."
  (interactive)
  (vc-ensure-vc-buffer)
  (let ((file buffer-file-name)
	;; This operation should always ask for confirmation.
	(vc-suppress-confirm nil)

      (vc-diff nil t)
      (vc-exec-after `(message nil))
      (unwind-protect
	  (if (not (yes-or-no-p "Discard changes? "))
	      (error "Revert canceled"))
	(if (and (window-dedicated-p (selected-window))
		 (one-window-p t))
	    (make-frame-invisible)
	  (delete-window))))
    (set-buffer obuf)
    ;; Do the reverting
    (message "Reverting %s..." file)
    (with-vc-properties

	(vc-resynch-buffer file t t)))
      (message "Version %s has been removed from the master" target))))

;;;autoload
(defun vc-switch-backend (file backend)
  "Make BACKEND the current version control system for FILE.
FILE must already be registered in BACKEND.  The change is not
permanent, only for the current session.  This function only changes
VC's perspective on FILE, it does not register or unregister it.
By default, this command cycles through the registered backends.
To get a prompt, use a prefix argument."
  (interactive
   (list
    buffer-file-name
    (let ((backend (vc-backend buffer-file-name))
	  (backends nil))
      ;; Find the registered backends.
      (dolist (backend vc-handled-backends)
	(when (vc-call-backend backend 'registered buffer-file-name)
	  (push backend backends)))
      ;; Find the next backend.
      (let ((def (car (delq backend (memq backend (append backends backends)))))
	    (others (delete backend backends)))
	(cond
	 ((null others) (error "No other backend to switch to"))
	 (current-prefix-arg
	  (intern
	   (upcase
	    (completing-read
	     (format "Switch to backend [%s]: " def)
	     (mapcar (lambda (b) (list (downcase (symbol-name b)))) backends)
	     nil t nil nil (downcase (symbol-name def))))))
       (t def))))))
  (unless (vc-call-backend backend 'registered file)
    (error "%s is not registered in %s" file backend))
  (vc-file-clearprops file)
  (vc-file-setprop file 'vc-backend backend)
  (vc-resynch-buffer file t t))

of the log entry buffer."
  (let ((old-backend (vc-backend file))
	(rev (vc-workfile-version file))
	(state (vc-state file))
	(comment (and move (vc-call comment-history file))))
    (if move (vc-unregister file))
    (vc-file-clearprops file)
    (if (not (vc-call-backend backend 'registered file))
	(with-vc-properties 
	 file
	 ;; TODO: If the file was 'edited under the old backend,