* Added a message-final that can be used to leave a message when handin is
done. * A little more pleasant error messages on submission errors. svn: r1026
This commit is contained in:
parent
e323d15247
commit
0946433c82
|
@ -93,23 +93,27 @@
|
|||
[parent button-panel]))
|
||||
|
||||
(define (submit-file)
|
||||
(define final-message "Handin successful.")
|
||||
(submit-assignment
|
||||
connection
|
||||
(send username get-value)
|
||||
(send passwd get-value)
|
||||
(send assignment get-string (send assignment get-selection))
|
||||
content
|
||||
;; on-commit
|
||||
(lambda ()
|
||||
(semaphore-wait commit-lock)
|
||||
(send status set-label "Comitting...")
|
||||
(set! committing? #t)
|
||||
(semaphore-post commit-lock))
|
||||
;; message/message-final/message-box handlers
|
||||
(lambda (msg) (send status set-label msg))
|
||||
(lambda (msg) (set! final-message msg))
|
||||
(lambda (msg styles) (message-box "Handin" msg this styles)))
|
||||
(queue-callback
|
||||
(lambda ()
|
||||
(when abort-commit-dialog (send abort-commit-dialog show #f))
|
||||
(send status set-label "Handin successful.")
|
||||
(send status set-label final-message)
|
||||
(set! committing? #f)
|
||||
(done-interface))))
|
||||
(define (retrieve-file)
|
||||
|
|
|
@ -64,12 +64,13 @@
|
|||
v)))
|
||||
|
||||
(define (submit-assignment h username passwd assignment content
|
||||
on-commit message message-box)
|
||||
on-commit message message-final message-box)
|
||||
(let ([r (handin-r h)] [w (handin-w h)])
|
||||
(define (read/message)
|
||||
(let ([v (read r)])
|
||||
(case v
|
||||
[(message) (message (read r)) (read/message)]
|
||||
[(message-final) (message-final (read r)) (read/message)]
|
||||
[(message-box)
|
||||
(write+flush w (message-box (read r) (read r))) (read/message)]
|
||||
[else v])))
|
||||
|
@ -93,7 +94,7 @@
|
|||
;; the resulting value written back
|
||||
(let ([v (read/message)])
|
||||
(unless (eq? 'confirm v)
|
||||
(error 'handin-connect "submit error: ~a" v)))
|
||||
(error (format "submit error: ~a" v))))
|
||||
(on-commit)
|
||||
(write+flush w 'check)
|
||||
(wait-for-ok r "commit" read/message)
|
||||
|
|
Loading…
Reference in New Issue
Block a user