Skip to content
Snippets Groups Projects
Commit a63471af authored by ch's avatar ch
Browse files

Added code to utimes(2) the user's file after check in.

parent 09e670f9
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.7 1990/03/02 23:29:08 ch Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/rcs.lisp,v 1.8 1990/03/03 00:01:15 ch Exp $
;;; ;;;
;;; Various commands for dealing with RCS under hemlock. ;;; Various commands for dealing with RCS under hemlock.
;;; ;;;
...@@ -133,12 +133,9 @@ ...@@ -133,12 +133,9 @@
(do-recursive-edit) (do-recursive-edit)
(message "Checking in ~A ..." (namestring pathname)) (message "Checking in ~A ..." (namestring pathname))
(in-directory pathname (let ((log-stream (make-hemlock-region-stream
(do-command "rcsci" `(,@(if keep-lock '("-l")) (buffer-region log-buffer))))
"-u" (sub-check-in-file pathname keep-lock log-stream))
,(file-namestring pathname))
:input (make-hemlock-region-stream
(buffer-region log-buffer))))
(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."))
...@@ -146,6 +143,33 @@ ...@@ -146,6 +143,33 @@
(setf allow-delete t) (setf allow-delete t)
(delete-buffer-if-possible buffer)))) (delete-buffer-if-possible buffer))))
(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"
,(file-namestring pathname))
: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 rcs-filename (list atime mtime))
(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))))))))
;;;; Check Out ;;;; Check Out
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment