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

remember the last-chosen assignment

Browse Source 
svn: r12440
This commit is contained in:
Eli Barzilay 2008-11-14 05:01:55 +00:00
parent dc3ad7e2f3
commit dc4eb77b10
1 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/handin-client/client-gui.ss
View File

@ -44,6 +44,8 @@
(define (remember-user user) (define (remember-user user)
(preferences:set preference-key user)) (preferences:set preference-key user))
(define remembered-assignment (make-parameter #f))
(define (connect) (handin-connect server port-no)) (define (connect) (handin-connect server port-no))
;; parameter-like procedure that keeps the password cached for a few minutes ;; parameter-like procedure that keeps the password cached for a few minutes
@ -134,7 +136,10 @@
[label "Assignment:"] [label "Assignment:"]
[choices null] [choices null]
[parent this] [parent this]
[callback void] [callback (lambda (c e)
(remembered-assignment
(send assignment get-string
(send assignment get-selection))))]
[stretchable-width #t])) [stretchable-width #t]))
(define button-panel (define button-panel
@ -304,13 +309,17 @@
(escape))]) (escape))])
(semaphore-wait go-sema) (semaphore-wait go-sema)
(let* ([h (connect)] (let* ([h (connect)]
[l (retrieve-active-assignments h)]) [l (retrieve-active-assignments h)]
[n (cond [(member (remembered-assignment) l)
=> (lambda (r) (- (length l) (length r)))]
[else 0])])
(when (null? l) (when (null? l)
(handin-disconnect h) (handin-disconnect h)
(error 'handin "there are no active assignments")) (error 'handin "there are no active assignments"))
(set! connection h) (set! connection h)
(for ([assign (in-list l)]) (send assignment append assign)) (for ([assign (in-list l)]) (send assignment append assign))
(send assignment enable #t) (send assignment enable #t)
(send assignment set-selection n)
(set! ok-can-enable? #t) (set! ok-can-enable? #t)
(activate-ok) (activate-ok)
(send status set-label (send status set-label