suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed let-values

Browse Source 
original commit: 9e85d7cf11580b2be03787a28178bcb8038a1bd2
This commit is contained in:
Robby Findler 1996-09-12 21:56:37 +00:00
parent 8e82ccef96
commit 26c56232f7
1 changed files with 44 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
collects/mred/keys.ss
View File

@ -69,50 +69,50 @@
(k (wx:message-box "no file associated with this edit")))
(let-values ([(my-out my-in my-pid my-err)
(apply values (process* (build-path rcs-pathname "rlog")
"-L" "-R" (string-append "-l" username) filename))]
[(their-out their-in their-pid their-err)
(apply values (process* (build-path rcs-pathname "rlog")
"-L" "-R" "-l" filename))])
(let ([my-lock? (not (eof-object? (read my-out)))]
[locked? (not (eof-object? (read their-out)))])
(for-each close-input-port (list my-out my-err their-out their-err))
(for-each close-output-port (list my-in their-in))
(cond
[(not (system* (build-path rcs-pathname "rlog") "-h" "-q" filename))
(system* (build-path rcs-pathname "ci") "-t-" filename)
(wx:message-box "Initial Checkin Completed")]
[my-lock?
(when (send edit modified?)
(case (mred:gui-utils:unsaved-warning (send edit get-filename) "Checkin" #t)
[(save) (send edit save-file (send edit get-filename)
(send edit get-file-format))]
[(cancel) (k (void))]
[else (void)]))
(let* ([msg (wx:get-text-from-user "Please Enter Log Message"
"Check In"
last-checkin-string)]
[result (system* (build-path rcs-pathname "ci")
"-u" (string-append "-m" msg) filename)])
(set! last-checkin-string msg)
(if result
(send edit load-file
(send edit get-filename)
(send edit get-file-format))
(wx:message-box "Checkin Unsucessful")))]
[locked? (wx:message-box "Someone else has the lock")]
[else
(let ([current-dir (current-directory)])
(let-values ([(base name _) (split-path filename)])
(unless (eq? 'relative base)
(current-directory base))
(let ([res (system* (build-path rcs-pathname "co")
"-q" "-l" name)])
(current-directory current-dir)
(if res
(send edit load-file
(send edit get-filename)
(send edit get-file-format))
(wx:message-box "Checkout Failed")))))])))))))]
"-L" "-R" (string-append "-l" username) filename))])
(let-values ([(their-out their-in their-pid their-err)
(apply values (process* (build-path rcs-pathname "rlog")
"-L" "-R" "-l" filename))])
(let ([my-lock? (not (eof-object? (read my-out)))]
[locked? (not (eof-object? (read their-out)))])
(for-each close-input-port (list my-out my-err their-out their-err))
(for-each close-output-port (list my-in their-in))
(cond
[(not (system* (build-path rcs-pathname "rlog") "-h" "-q" filename))
(system* (build-path rcs-pathname "ci") "-t-" filename)
(wx:message-box "Initial Checkin Completed")]
[my-lock?
(when (send edit modified?)
(case (mred:gui-utils:unsaved-warning (send edit get-filename) "Checkin" #t)
[(save) (send edit save-file (send edit get-filename)
(send edit get-file-format))]
[(cancel) (k (void))]
[else (void)]))
(let* ([msg (wx:get-text-from-user "Please Enter Log Message"
"Check In"
last-checkin-string)]
[result (system* (build-path rcs-pathname "ci")
"-u" (string-append "-m" msg) filename)])
(set! last-checkin-string msg)
(if result
(send edit load-file
(send edit get-filename)
(send edit get-file-format))
(wx:message-box "Checkin Unsucessful")))]
[locked? (wx:message-box "Someone else has the lock")]
[else
(let ([current-dir (current-directory)])
(let-values ([(base name _) (split-path filename)])
(unless (eq? 'relative base)
(current-directory base))
(let ([res (system* (build-path rcs-pathname "co")
"-q" "-l" name)])
(current-directory current-dir)
(if res
(send edit load-file
(send edit get-filename)
(send edit get-file-format))
(wx:message-box "Checkout Failed")))))]))))))))]
[ring-bell
(lambda (edit event)