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

it is now possible to have hidden user fields

Browse Source 
svn: r1810
This commit is contained in:
Eli Barzilay 2006-01-12 00:24:42 +00:00
parent 3cd38a3d25
commit 4f4a6353c0
2 changed files with 27 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -274,15 +274,16 @@
(super-new [label manage-dialog-name]
[alignment '(left center)])
(define EXTRA-FIELDS
(define USER-FIELDS
(let ([ef #f])
(lambda ()
(unless ef (set! ef (retrieve-extra-fields (connect))))
(unless ef (set! ef (retrieve-user-fields (connect))))
ef)))
(define status
(new message%
[label (format "Manage ~a handin account at ~a." handin-name server)]
[label (format "Manage ~a handin account at ~a."
handin-name server)]
[parent this]
[stretchable-width #t]))
@ -320,7 +321,7 @@
(string=? (send t1 get-value) (send t2 get-value)))
(define (activate-change)
(define an-extra-non-empty? (ormap non-empty? change-extra-fields))
(define an-extra-non-empty? (ormap non-empty? change-user-fields))
(send retrieve-old-info-button enable
(non-empty? old-username old-passwd))
(send change-button enable
@ -338,10 +339,10 @@
(define old-passwd
(mk-passwd "Old Password:" old-user-box activate-change))
(define change-extra-fields
(define change-user-fields
(map (lambda (f)
(mk-txt (string-appeng f ":") old-user-box activate-change))
(EXTRA-FIELDS)))
(mk-txt (string-append f ":") old-user-box activate-change))
(USER-FIELDS)))
(define new-passwd
(mk-passwd "New Password:" old-user-box activate-change))
(define new-passwd2
@ -365,20 +366,17 @@
(define (activate-new)
(send new-button enable
(and (apply non-empty? new-username add-passwd add-passwd2
add-extra-fields)
add-user-fields)
(same-value add-passwd add-passwd2))))
(define new-user-box (new vertical-panel%
[parent single]
[alignment '(center center)]))
(define new-username (mk-txt "Username:" new-user-box activate-new))
(send new-username set-value (remembered-user))
(define add-extra-fields
(define add-user-fields
(map (lambda (f)
(mk-txt (string-append f ":") new-user-box activate-new))
(EXTRA-FIELDS)))
;; (define full-name (mk-txt "Full Name:" new-user-box activate-new))
;; (define student-id (mk-txt "ID:" new-user-box activate-new))
;; (define email (mk-txt "Email:" new-user-box activate-new))
(USER-FIELDS)))
(define add-passwd (mk-passwd "Password:" new-user-box activate-new))
(define add-passwd2 (mk-passwd "Password again:" new-user-box activate-new))
(define new-button (new button%
@ -470,8 +468,8 @@
l1 l2))
(k (void))))
(for-each (lambda (t f) (check-length t 100 f k))
(if new? add-extra-fields change-extra-fields)
(EXTRA-FIELDS))
(if new? add-user-fields change-user-fields)
(USER-FIELDS))
(send tabs enable #f)
(parameterize ([current-custodian comm-cust])
(thread
@ -493,9 +491,9 @@
(if new? "Creating user..." "Updating server..."))
(if new?
(run submit-addition username add-passwd
add-extra-fields)
add-user-fields)
(run submit-info-change username old-passwd new-passwd
change-extra-fields)))
change-user-fields)))
(send status set-label "Success.")
(send cancel set-label "Close")))))))
@ -521,7 +519,7 @@
"Success, you can now edit fields.")
(send tabs enable #t)
(for-each (lambda (f val) (send f set-value val))
change-extra-fields vals)
change-user-fields vals)
(activate-change)))))))))
(send new-user-box show #f)

22
collects/handin-client/client.ss
View File

@ -3,7 +3,7 @@
(provide handin-connect
handin-disconnect
retrieve-extra-fields
retrieve-user-fields
retrieve-active-assignments
submit-assignment
retrieve-assignment
@ -47,14 +47,14 @@
(write+flush (handin-w h) 'bye)
(close-handin-ports h))
(define (retrieve-extra-fields h)
(define (retrieve-user-fields h)
(let ([r (handin-r h)] [w (handin-w h)])
(write+flush w 'get-extra-fields 'bye)
(write+flush w 'get-user-fields 'bye)
(let ([v (read r)])
(unless (and (list? v) (andmap string? v))
(error 'handin-connect
"failed to get extra-fields list from server"))
(wait-for-ok r "get-extra-fields")
"failed to get user-fields list from server"))
(wait-for-ok r "get-user-fields")
(close-handin-ports h)
v)))
@ -119,24 +119,24 @@
(close-handin-ports h)
buf))))
(define (submit-addition h username passwd extra-fields)
(define (submit-addition h username passwd user-fields)
(let ([r (handin-r h)] [w (handin-w h)])
(write+flush w
'set 'username/s username
'set 'password passwd
'set 'extra-fields extra-fields
'set 'username/s username
'set 'password passwd
'set 'user-fields user-fields
'create-user)
(wait-for-ok r "create-user")
(close-handin-ports h)))
(define (submit-info-change h username old-passwd new-passwd extra-fields)
(define (submit-info-change h username old-passwd new-passwd user-fields)
(let ([r (handin-r h)]
[w (handin-w h)])
(write+flush w
'set 'username/s username
'set 'password old-passwd
'set 'new-password new-passwd
'set 'extra-fields extra-fields
'set 'user-fields user-fields
'change-user-info)
(wait-for-ok r "change-user-info")
(close-handin-ports h)))