From 2cf16ed9584c26cc392a382b8760cec7cb7441b3 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Thu, 7 Nov 1991 21:54:24 +0000
Subject: [PATCH] Fixed the check-in stuff to work better.  The flag to
 indicate whether or not the working copy should be kept is now a hemlock
 variable so it can be set on a per-buffer basis (probably in a read-file
 hook).

---
 hemlock/rcs.lisp | 59 ++++++++++++++++++++++++++++--------------------
 1 file changed, 34 insertions(+), 25 deletions(-)

diff --git a/hemlock/rcs.lisp b/hemlock/rcs.lisp
index cf96f4e04..f0fce1bf5 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.17 1991/11/07 21:22:38 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/rcs.lisp,v 1.18 1991/11/07 21:54:24 wlott Exp $
 ;;;
 ;;; Various commands for dealing with RCS under Hemlock.
 ;;;
@@ -113,6 +113,11 @@
   "RCS Check In File Hook"
   :value nil)
 
+(defhvar "RCS Keep Around After Unlocking"
+  "If non-NIL (the default) keep the working file around after unlocking it.
+   When NIL, the working file and buffer are deleted."
+  :value t)
+
 (defun rcs-check-in-file (buffer pathname keep-lock)
   (let ((old-buffer (current-buffer))
 	(allow-delete nil)
@@ -139,7 +144,7 @@
 			 (namestring pathname) keep-lock)
 		(let ((log-stream (make-hemlock-region-stream
 				   (buffer-region log-buffer))))
-		  (sub-check-in-file pathname keep-lock log-stream))
+		  (sub-check-in-file pathname buffer keep-lock log-stream))
 		(invoke-hook rcs-check-in-file-hook buffer pathname)
 		nil)
 	  (editor-error "Someone deleted the RCS Log Entry buffer."))
@@ -147,35 +152,39 @@
       (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)
+(defun sub-check-in-file (pathname buffer keep-lock log-stream)
   (let* ((filename (file-namestring pathname))
 	 (rcs-filename (concatenate 'simple-string
-				    "./RCS/" filename ",v")))
+				    "./RCS/" filename ",v"))
+	 (keep-working-copy (or keep-lock
+				(variable-value
+				 'rcs-keep-around-after-unlocking
+				 :buffer buffer))))
     (in-directory pathname
       (do-command "rcsci" `(,@(if keep-lock '("-l"))
-			    ,@(if (or keep-lock *keep-around-unlocked-files*)
-				  "-u")
+			    ,@(if keep-working-copy "-u")
 			    ,filename)
 		  :input log-stream)
-      ;; 
-      ;; Set the times on the user's file to be equivalent to that of
-      ;; the rcs file.
-      (multiple-value-bind
-	  (dev ino mode nlink uid gid rdev size atime mtime)
-	  (mach:unix-stat rcs-filename)
-	(declare (ignore mode nlink uid gid rdev size))
-	(cond (dev
-	       (multiple-value-bind
-		   (wonp errno)
-		   (mach:unix-utimes filename (list atime 0 mtime 0))
-		 (unless wonp
-		   (editor-error "MACH:UNIX-UTIMES failed: ~A"
-				 (mach:get-unix-error-msg errno)))))
-	      (t
-	       (editor-error "MACH:UNIX-STAT failed: ~A"
-			     (mach:get-unix-error-msg ino))))))))
+      (if keep-working-copy
+	  ;; 
+	  ;; Set the times on the user's file to be equivalent to that of
+	  ;; the rcs file.
+	  (multiple-value-bind
+	      (dev ino mode nlink uid gid rdev size atime mtime)
+	      (mach:unix-stat rcs-filename)
+	    (declare (ignore mode nlink uid gid rdev size))
+	    (cond (dev
+		   (multiple-value-bind
+		       (wonp errno)
+		       (mach:unix-utimes filename (list atime 0 mtime 0))
+		     (unless wonp
+		       (editor-error "MACH:UNIX-UTIMES failed: ~A"
+				     (mach:get-unix-error-msg errno)))))
+		  (t
+		   (editor-error "MACH:UNIX-STAT failed: ~A"
+				 (mach:get-unix-error-msg ino)))))
+	  (delete-buffer-if-possible buffer)))))
+
 
 
 ;;;; Check Out
-- 
GitLab