Mercurial > emacs

changeset 32058:4196f89984ce

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* 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'.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Sun, 01 Oct 2000 19:35:24 +0000
parents acd9a3daf12b
children 13e0fdf65e3c
files lisp/vc-rcs.el lisp/vc.el
diffstat 2 files changed, 80 insertions(+), 52 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/vc-rcs.el	Sun Oct 01 14:46:50 2000 +0000
+++ b/lisp/vc-rcs.el	Sun Oct 01 19:35:24 2000 +0000
@@ -5,7 +5,7 @@
 ;; Author:     FSF (see vc.el for full credits)
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
 
-;; $Id: vc-rcs.el,v 1.7 2000/09/22 11:57:30 gerd Exp $
+;; $Id: vc-rcs.el,v 1.8 2000/10/01 11:17:42 spiegel Exp $
 
 ;; This file is part of GNU Emacs.
 
@@ -29,7 +29,7 @@
 ;;; Code:
 
 (eval-when-compile
-  (require 'vc))	;for macros defined there
+  (require 'cl))
 
 (defcustom vc-rcs-release nil
   "*The release number of your RCS installation, as a string.
@@ -716,8 +716,12 @@
 If this leaves the RCS subdirectory empty, ask the user
 whether to remove it."
   (let* ((master (vc-name file))
-	 (dir (file-name-directory master)))
-    (delete-file master)
+	 (dir (file-name-directory master))
+	 (backup-info (find-backup-file-name master)))
+    (if (not backup-info)
+	(delete-file master)
+      (rename-file master (car backup-info) 'ok-if-already-exists)
+      (dolist (f (cdr backup-info)) (ignore-errors (delete-file f))))
     (and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
 	 ;; check whether RCS dir is empty, i.e. it does not
 	 ;; contain any files except "." and ".."
@@ -733,22 +737,20 @@
 	(state (vc-state file))
 	(checkout-model (vc-checkout-model file))
 	(comment (and move (vc-call comment-history file))))
-    (if move (vc-unregister file old-backend))
+    (if move (vc-unregister file))
     (vc-file-clearprops file)
     (if (not (vc-rcs-registered file))
 	(progn
-	  (with-vc-properties 
-	   file
-	   ;; TODO: If the file was 'edited under the old backend,
-	   ;; this should actually register the version 
-	   ;; it was based on.
-	   (vc-rcs-register file rev "")
-	   `((vc-backend ,backend)))
+	  ;; TODO: If the file was 'edited under the old backend,
+	  ;; this should actually register the version 
+	  ;; it was based on.
+	  (vc-rcs-register file rev "")
+	  (vc-file-setprop file 'vc-backend 'RCS)
 	  (if (eq checkout-model 'implicit)
 	      (vc-rcs-set-non-strict-locking file))
 	  (if (not move)
 	      (vc-do-command nil 0 "rcs" file (concat "-b" rev ".1"))))
-      (vc-file-setprop file 'vc-backend backend)
+      (vc-file-setprop file 'vc-backend 'RCS)
       (vc-file-setprop file 'vc-state 'edited)
       (set-file-modes file
 		      (logior (file-modes file) 128)))
--- a/lisp/vc.el	Sun Oct 01 14:46:50 2000 +0000
+++ b/lisp/vc.el	Sun Oct 01 19:35:24 2000 +0000
@@ -150,6 +150,7 @@
 (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}
@@ -492,8 +493,7 @@
 
 (defsubst vc-editable-p (file)
   (or (eq (vc-checkout-model file) 'implicit)
-      (eq (vc-state file) 'edited)
-      (eq (vc-state file) 'needs-merge)))
+      (memq (vc-state file) '(edited needs-merge))))
 
 ;;; Two macros for elisp programming
 ;;;###autoload
@@ -522,7 +522,7 @@
 However, before executing BODY, find FILE, and after BODY, save buffer."
   `(with-vc-file
     ,file ,comment
-    (find-file ,file)
+    (set-buffer (find-file-noselect ,file))
     ,@body
     (save-buffer)))
 
@@ -821,7 +821,7 @@
       ;; will check whether the file on disk is newer.
       (if vc-dired-mode
 	  (find-file-other-window file)
-	(find-file 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))
@@ -1067,7 +1067,7 @@
                   "Enter initial comment."
 		  (lambda (file rev comment)
 		    (message "Registering %s... " file)
-		    (let ((backend (vc-responsible-backend 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)
@@ -1076,27 +1076,34 @@
 			(setq backup-inhibited t)))
 		    (message "Registering %s... done" file))))
 
-(defun vc-responsible-backend (file &optional register)
+(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 (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)))))
+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.  
@@ -1108,13 +1115,13 @@
 The default implementation returns t for all files."
   t)
 
-(defun vc-unregister (file backend)
+(defun vc-unregister (file)
   "Unregister FILE from version control system BACKEND."
-  (vc-call-backend backend 'unregister file)
+  (vc-call unregister file)
   (vc-file-clearprops file))
 
 (defun vc-default-unregister (backend file)
-  "Default implementation of vc-unregister, signals an error."
+  "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)
@@ -1588,7 +1595,7 @@
 	      (save-excursion
 		(vc-call-backend backend 'clear-headers))
 	      (vc-restore-buffer-context context))
-	  (find-file filename)
+	  (set-buffer (find-file-noselect filename))
 	  (vc-call-backend backend 'clear-headers)
 	  (kill-buffer filename)))))
 
@@ -2138,9 +2145,8 @@
 (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."
+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)
@@ -2153,9 +2159,9 @@
       (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))
+	(if (and (window-dedicated-p (selected-window))
+		 (one-window-p t))
+	    (make-frame-invisible)
 	  (delete-window))))
     (set-buffer obuf)
     ;; Do the reverting
@@ -2218,14 +2224,34 @@
 
 ;;;autoload
 (defun vc-switch-backend (file backend)
-  "Make BACKEND the current version control system for FILE.  
+  "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 
+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
-    (intern (upcase (read-string "Switch to backend: ")))))
+    (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)
@@ -2265,7 +2291,7 @@
 	(rev (vc-workfile-version file))
 	(state (vc-state file))
 	(comment (and move (vc-call comment-history file))))
-    (if move (vc-unregister file old-backend))
+    (if move (vc-unregister file))
     (vc-file-clearprops file)
     (if (not (vc-call-backend backend 'registered file))
 	(with-vc-properties