diff --git a/hemlock/rcs.lisp b/hemlock/rcs.lisp
index f9a09e8d87b83628a58eee17149b3848e2154463..cf96f4e048ff86e2066df1c32e6c3bf74e3e87dc 100644
--- a/hemlock/rcs.lisp
+++ b/hemlock/rcs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Package: HEMLOCK; Mode: Lisp -*-
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/rcs.lisp,v 1.16 1990/05/30 16:27:22 ch Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/rcs.lisp,v 1.17 1991/11/07 21:22:38 wlott Exp $
 ;;;
 ;;; Various commands for dealing with RCS under Hemlock.
 ;;;
@@ -44,8 +44,8 @@
 	 (:exited
 	  (unless (zerop (ext:process-exit-code process))
 	    (editor-error "~A aborted with an error; ~
-	    use the ``RCS Last Command Output'' command for more ~
-	    information" ',command)))
+			   use the ``RCS Last Command Output'' command for ~
+			   more information" ',command)))
 	 (:signaled
 	  (editor-error "~A killed with signal ~A~@[ (core dumped)]."
 			',command
@@ -147,14 +147,17 @@
       (setf allow-delete t)
       (delete-buffer-if-possible log-buffer))))
 
+(defvar *keep-around-unlocked-files* t)
+
 (defun sub-check-in-file (pathname keep-lock log-stream)
   (let* ((filename (file-namestring pathname))
 	 (rcs-filename (concatenate 'simple-string
 				    "./RCS/" filename ",v")))
     (in-directory pathname
       (do-command "rcsci" `(,@(if keep-lock '("-l"))
-			      "-u"
-			      ,filename)
+			    ,@(if (or keep-lock *keep-around-unlocked-files*)
+				  "-u")
+			    ,filename)
 		  :input log-stream)
       ;; 
       ;; Set the times on the user's file to be equivalent to that of
@@ -181,77 +184,56 @@
   "RCS Check Out File Hook"
   :value nil)
 
+(defvar *translate-file-names-before-locking* nil)
+
 (defun maybe-rcs-check-out-file (buffer pathname lock always-overwrite-p)
-  (sub-maybe-rcs-check-out-files buffer (list pathname)
-				 lock always-overwrite-p))
-
-(defun maybe-rcs-check-out-files (pathnames lock always-overwrite-p)
-  (sub-maybe-rcs-check-out-files nil pathnames lock always-overwrite-p))
-
-(defun sub-maybe-rcs-check-out-files (buffer pathnames lock always-overwrite-p)
-  (let ((check-out-count 0))
-    (macrolet ((frob ()
-		 `(progn
-		    (rcs-check-out-file buffer pathname lock)
-		    (incf check-out-count))))
-      (dolist (pathname pathnames)
-	(cond
-	 ((and (not always-overwrite-p)
-	       (probe-file pathname) (ext:file-writable pathname))
-	  ;; File exists and is writable so check and see if the user really
-	  ;; wants to check it out.
-	  (command-case (:prompt
-			 (format nil "The file ~A is writable.  Overwrite? "
-				 (file-namestring pathname))
-			 :help
-			 "Type one of the following single-character commands:")
-	    ((:yes :confirm)
-	     "Overwrite the file."
-	     (frob))
-	    (:no
-	     "Skip checking out this file.")
-	    ((#\r #\R)
-	     "Rename the file before checking it out."
-	     (let ((new-pathname (prompt-for-file
-				  :prompt "New Filename: "
-				  :default (buffer-default-pathname
-					      (current-buffer))
-				  :must-exist nil)))
-	       (rename-file pathname new-pathname)
-	       (frob)))
-	    (:do-all
-	     "Overwrite this file and all remaining files."
-	     (setf always-overwrite-p t)
-	     (frob))
-	    (:do-once
-	     "Overwrite this file and then exit."
-	     (frob)
-	     (return))))
-	 (t
-	  (frob)))))
-    check-out-count))
+  (when (and lock *translate-file-names-before-locking*)
+    (multiple-value-bind (unmatched-dir new-dirs file-name)
+			 (maybe-translate-definition-file pathname)
+      (let ((new-name (translate-definition-file unmatched-dir
+						 (car new-dirs)
+						 file-name)))
+	(when (probe-file (directory-namestring new-name))
+	  (setf pathname new-name)))))
+  (cond
+   ((and (not always-overwrite-p)
+	 (probe-file pathname) (ext:file-writable pathname))
+    ;; File exists and is writable so check and see if the user really
+    ;; wants to check it out.
+    (command-case (:prompt
+		   (format nil "The file ~A is writable.  Overwrite? "
+			   (file-namestring pathname))
+		   :help
+		   "Type one of the following single-character commands:")
+      ((:yes :confirm)
+       "Overwrite the file."
+       (rcs-check-out-file buffer pathname lock))
+      (:no
+       "Don't check it out after all.")
+      ((#\r #\R)
+       "Rename the file before checking it out."
+       (let ((new-pathname (prompt-for-file
+			    :prompt "New Filename: "
+			    :default (buffer-default-pathname
+				      (current-buffer))
+			    :must-exist nil)))
+	 (rename-file pathname new-pathname)
+	 (rcs-check-out-file buffer pathname lock)))))
+   (t
+    (rcs-check-out-file buffer pathname lock)))
+  pathname)
 
 (defun rcs-check-out-file (buffer pathname lock)
   (message "Checking out ~A~:[~; with a lock~] ..." (namestring pathname) lock)
   (in-directory pathname
-    (let ((backup
-	   (if (probe-file pathname)
-	       (lisp::pick-backup-name (namestring pathname))
-	       nil)))
-      (when backup (rename-file pathname backup))
-      (do-command "rcsco" `(,@(if lock '("-l")) ,(file-namestring pathname)))
+    (let* ((file (file-namestring pathname))
+	   (backup (if (probe-file file)
+		       (lisp::pick-backup-name file))))
+      (when backup (rename-file file backup))
+      (do-command "rcsco" `(,@(if lock '("-l")) ,file))
       (invoke-hook rcs-check-out-file-hook buffer pathname)
       (when backup (delete-file backup)))))
 
-(defun pick-temp-file (defaults)
-  (let ((index 0))
-    (loop
-      (let ((name (merge-pathnames (format nil ",rcstmp-~D" index) defaults)))
-	(cond ((probe-file name)
-	       (incf index))
-	      (t
-	       (return name)))))))
-
 
 ;;;; Last Command Output
 
@@ -266,7 +248,16 @@
     (write-line *last-rcs-command-output-string* s)))
 
 
-;;;; Checking In / Checking Out and Locking / Unlocking 
+;;;; Commands for Checking In / Checking Out and Locking / Unlocking 
+
+(defun pick-temp-file (defaults)
+  (let ((index 0))
+    (loop
+      (let ((name (merge-pathnames (format nil ",rcstmp-~D" index) defaults)))
+	(cond ((probe-file name)
+	       (incf index))
+	      (t
+	       (return name)))))))
 
 (defcommand "RCS Lock Buffer File" (p)
   "Attempt to lock the file in the current buffer."
@@ -351,8 +342,8 @@
     (when (buffer-modified buffer)
       (when (not (prompt-for-y-or-n :prompt "Buffer is modified, overwrite? "))
 	(editor-error "Aborted.")))
-    (maybe-rcs-check-out-file buffer pathname p nil)
     (setf (buffer-modified buffer) nil)
+    (setf pathname (maybe-rcs-check-out-file buffer pathname p nil))
     (when p
       (setf (buffer-writable buffer) t)
       (message "Buffer is now writable."))
@@ -369,7 +360,7 @@
 				   :default (buffer-default-pathname
 					     (current-buffer))
 				   :must-exist nil)))
-    (maybe-rcs-check-out-file nil pathname p nil)
+    (setf pathname (maybe-rcs-check-out-file nil pathname p nil))
     (find-file-command nil pathname)))
 
 
@@ -426,83 +417,6 @@
     (buffer-start (current-point))
     (setf (buffer-modified buffer) nil)))
 
-
-;;;; Directory Support
-
-(defun list-out-of-date-files (dir)
-  (let ((rcsdir (make-pathname :host (pathname-host dir)
-			       :device (pathname-device dir)
-			       :directory (concatenate 'simple-vector
-						       (pathname-directory dir)
-						       (vector "RCS"))))
-	(out-of-date-files nil))
-    (unless (directoryp rcsdir)
-      (editor-error "Could not find the RCS directory."))
-    (dolist (rcsfile (directory rcsdir))
-      (let ((rcsname (file-namestring rcsfile)))
-	(when (string= rcsname ",v" :start1 (- (length rcsname) 2))
-	  (let* ((name (subseq rcsname 0 (- (length rcsname) 2)))
-		 (file (merge-pathnames (parse-namestring name) dir)))
-	    (unless (and (probe-file file)
-			 (>= (file-write-date file) (file-write-date rcsfile)))
-	      (push file out-of-date-files))))))
-    out-of-date-files))
-
-(defun rcs-prompt-for-directory (prompt)
-  (let* ((default (buffer-default-pathname (current-buffer)))
-	 (dir (prompt-for-file :prompt prompt
-			       :default (make-pathname
-					 :host (pathname-host default)
-					 :device (pathname-device default)
-					 :directory (pathname-directory default)
-					 :defaults nil)
-			       :must-exist nil)))
-    (unless (directoryp dir)
-      (let ((with-slash (parse-namestring (concatenate 'simple-string
-						       (namestring dir)
-						       "/"))))
-	(unless (directoryp with-slash)
-	  (editor-error "~S is not a directory" (namestring dir)))
-	(setf dir with-slash)))
-    dir))
-
-(defcommand "RCS Update Directory" (p)
-  "Prompt for a directory and check out all files that are older than
-  their corresponding RCS files.  With an argument, never ask about
-  overwriting writable files."
-  "Prompt for a directory and check out all files that are older than
-  the corresponding RCS file.  With an argument, never ask about
-  overwriting writable files."
-  (let* ((directory (rcs-prompt-for-directory "Directory to update: "))
-	 (out-of-date-files (list-out-of-date-files directory))
-	 (n-out-of-date (length out-of-date-files)))
-    (cond ((zerop n-out-of-date)
-	   (message "All RCS files in ~A are up to date."
-		    (namestring directory)))
-	  (t
-	   (let ((n-checked-out
-		  (maybe-rcs-check-out-files out-of-date-files nil p)))
-	     (message "Number of files out of date: ~D; ~
-	     number of files checked out: ~D"
-		      n-out-of-date n-checked-out)))))))
-
-(defcommand "RCS List Out Of Date Files" (p)
-  "Prompt for a directory and list all of the files that are older than
-  their corresponding RCS files."
-  "Prompt for a directory and list all of the files that are older than
-  their corresponding RCS files."
-  (declare (ignore p))
-  (let* ((directory (rcs-prompt-for-directory "Directory: "))
-	 (out-of-date-files (list-out-of-date-files directory)))
-    (cond ((null out-of-date-files)
-	   (message "All RCS files in ~A are up to date."
-		    (namestring directory)))
-	  (t
-	   (with-pop-up-display (s :buffer-name "*RCS Out of Date Files*")
-	     (format s "Directory: ~A~%~%" (namestring directory))
-	     (dolist (file out-of-date-files)
-	       (format s "~A~%" (file-namestring file))))))))
-
 
 ;;;; Status and Modeline Frobs.