Skip to content
Snippets Groups Projects
Commit 2cf16ed9 authored by wlott's avatar wlott
Browse files

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).
parent 9717fd0b
No related branches found
No related tags found
No related merge requests found
;;; -*- Package: HEMLOCK; Mode: Lisp -*- ;;; -*- 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. ;;; Various commands for dealing with RCS under Hemlock.
;;; ;;;
...@@ -113,6 +113,11 @@ ...@@ -113,6 +113,11 @@
"RCS Check In File Hook" "RCS Check In File Hook"
:value nil) :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) (defun rcs-check-in-file (buffer pathname keep-lock)
(let ((old-buffer (current-buffer)) (let ((old-buffer (current-buffer))
(allow-delete nil) (allow-delete nil)
...@@ -139,7 +144,7 @@ ...@@ -139,7 +144,7 @@
(namestring pathname) keep-lock) (namestring pathname) keep-lock)
(let ((log-stream (make-hemlock-region-stream (let ((log-stream (make-hemlock-region-stream
(buffer-region log-buffer)))) (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) (invoke-hook rcs-check-in-file-hook buffer pathname)
nil) nil)
(editor-error "Someone deleted the RCS Log Entry buffer.")) (editor-error "Someone deleted the RCS Log Entry buffer."))
...@@ -147,35 +152,39 @@ ...@@ -147,35 +152,39 @@
(setf allow-delete t) (setf allow-delete t)
(delete-buffer-if-possible log-buffer)))) (delete-buffer-if-possible log-buffer))))
(defvar *keep-around-unlocked-files* t) (defun sub-check-in-file (pathname buffer keep-lock log-stream)
(defun sub-check-in-file (pathname keep-lock log-stream)
(let* ((filename (file-namestring pathname)) (let* ((filename (file-namestring pathname))
(rcs-filename (concatenate 'simple-string (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 (in-directory pathname
(do-command "rcsci" `(,@(if keep-lock '("-l")) (do-command "rcsci" `(,@(if keep-lock '("-l"))
,@(if (or keep-lock *keep-around-unlocked-files*) ,@(if keep-working-copy "-u")
"-u")
,filename) ,filename)
:input log-stream) :input log-stream)
;; (if keep-working-copy
;; Set the times on the user's file to be equivalent to that of ;;
;; the rcs file. ;; Set the times on the user's file to be equivalent to that of
(multiple-value-bind ;; the rcs file.
(dev ino mode nlink uid gid rdev size atime mtime) (multiple-value-bind
(mach:unix-stat rcs-filename) (dev ino mode nlink uid gid rdev size atime mtime)
(declare (ignore mode nlink uid gid rdev size)) (mach:unix-stat rcs-filename)
(cond (dev (declare (ignore mode nlink uid gid rdev size))
(multiple-value-bind (cond (dev
(wonp errno) (multiple-value-bind
(mach:unix-utimes filename (list atime 0 mtime 0)) (wonp errno)
(unless wonp (mach:unix-utimes filename (list atime 0 mtime 0))
(editor-error "MACH:UNIX-UTIMES failed: ~A" (unless wonp
(mach:get-unix-error-msg errno))))) (editor-error "MACH:UNIX-UTIMES failed: ~A"
(t (mach:get-unix-error-msg errno)))))
(editor-error "MACH:UNIX-STAT failed: ~A" (t
(mach:get-unix-error-msg ino)))))))) (editor-error "MACH:UNIX-STAT failed: ~A"
(mach:get-unix-error-msg ino)))))
(delete-buffer-if-possible buffer)))))
;;;; Check Out ;;;; Check Out
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment