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

minor tweaks

Browse Source 
svn: r11710
This commit is contained in:
Eli Barzilay 2008-09-13 00:51:21 +00:00
parent 72055191b4
commit 42e33b7d94
7 changed files with 24 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -256,9 +256,9 @@
(define interface-widgets
(list ok username passwd assignment retrieve?))
(define (disable-interface)
(for ([x interface-widgets]) (send x enable #f)))
(for ([x (in-list interface-widgets)]) (send x enable #f)))
(define (enable-interface)
(for ([x interface-widgets]) (send x enable #t) ))
(for ([x (in-list interface-widgets)]) (send x enable #t) ))
(define (done-interface)
(send cancel set-label "Close")
(send cancel focus))
@ -309,7 +309,7 @@
(handin-disconnect h)
(error 'handin "there are no active assignments"))
(set! connection h)
(for ([assign l]) (send assignment append assign))
(for ([assign (in-list l)]) (send assignment append assign))
(send assignment enable #t)
(set! ok-can-enable? #t)
(activate-ok)
@ -575,8 +575,8 @@
"Password Error"
(format "The \"~a\" and \"~a\" passwords are not the same." l1 l2))
(k (void))))
(for ([t (if new? add-user-fields change-user-fields)]
[f (or user-fields '())])
(for ([t (in-list (if new? add-user-fields change-user-fields))]
[f (in-list (or user-fields '()))])
(check-length t 100 f k))
(send tabs enable #f)
(parameterize ([current-custodian comm-cust])
@ -716,7 +716,7 @@
[stream (make-object editor-stream-out% base)])
(write-editor-version stream base)
(write-editor-global-header stream)
(for ([ed editors]) (send ed write-to-file stream))
(for ([ed (in-list editors)]) (send ed write-to-file stream))
(write-editor-global-footer stream)
(send base get-bytes)))

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

@ -19,7 +19,7 @@
(error (apply format fmt args)))
(define (write+flush port . xs)
(for ([x xs]) (write x port) (newline port))
(for ([x (in-list xs)]) (write x port) (newline port))
(flush-output port))
(define (close-handin-ports h)

4
collects/handin-client/handin-multi.ss
View File

@ -27,7 +27,7 @@
(let/ec return
(parameterize ([current-output-port (open-output-bytes)])
(printf "~a\n" magic)
(for ([file files])
(for ([file (in-list files)])
(let ([size (and (file-exists? file) (file-size file))])
(unless size (return #f))
(let ([buf (with-input-from-file file
@ -71,7 +71,7 @@
(string? (car x)) (bytes? (cadr x))))
files))
(error* "Error in retrieved content: bad format"))
(for ([file files])
(for ([file (in-list files)])
(let ([file (car file)] [buf (cadr file)])
(when (write? file)
(with-output-to-file file

2
collects/handin-client/updater.ss
View File

@ -17,7 +17,7 @@
(define (update!)
(let* ([in (file->inport package-filename)]
[outf (make-temporary-file "tmp~a.plt")]
[out (open-output-file outf 'binary 'truncate)])
[out (open-output-file outf #:mode 'binary #:exists 'truncate)])
(dynamic-wind
void
(lambda () (copy-port in out))

10
collects/handin-server/checker.ss
View File

@ -191,7 +191,7 @@
;; This code will hack textualization of text boxes
(define (insert-to-editor editor . xs)
(for ([x xs])
(for ([x (in-list xs)])
(send editor insert (if (string? x) x (make-object editor-snip% x)))))
;; support for "text-box%"
@ -282,7 +282,7 @@
'(ok-cancel caution)))))
(error* "Aborting...")))
;; This will create copies of the original files
;; (for ([file files])
;; (for ([file (in-list files)])
;; (with-output-to-file (car file)
;; (lambda () (display (cadr file)) (flush-output))))
(let* ([pfx-len (string-length markup-prefix)]
@ -298,7 +298,7 @@
(display ===)
(newline))
(parameterize ([current-output-port (open-output-bytes)])
(for ([file files])
(for ([file (in-list files)])
(sep (car file))
(parameterize ([current-input-port (open-input-bytes (cadr file))]
[current-processed-file (car file)])
@ -389,7 +389,7 @@
[user-post (id 'user-post)]
[(body ...) (syntax-case #'(body ...) ()
[() #'(void)] [_ #'(body ...)])])
(for ([x keyvals])
(for ([x (in-list keyvals)])
(unless (memq (car x) got)
(raise-syntax-error #f "unknown keyword" stx (cadr x))))
#'(begin
@ -470,7 +470,7 @@
(set-run-status "creating text file")
(with-output-to-file text-file #:exists 'truncate
(lambda ()
(for ([user users])
(for ([user (in-list users)])
(prefix-line (user-substs user student-line)))
(for-each prefix-line/substs extra-lines)
(for-each prefix-line/substs

14
collects/handin-server/main.ss
View File

@ -24,7 +24,7 @@
(error (apply format fmt args)))
(define (write+flush port . xs)
(for ([x xs]) (write x port) (newline port))
(for ([x (in-list xs)]) (write x port) (newline port))
(flush-output port))
(define-struct alist (name [l #:mutable]))
@ -87,7 +87,7 @@
;; SUCCESS, or things that are newer in the main submission
;; directory are kept (but subdirs in SUCCESS will are copied as
;; is))
(for ([f (directory-list dir)])
(for ([f (in-list (directory-list dir))])
(define dir/f (build-path dir f))
(cond [(not (or (file-exists? f) (directory-exists? f)))
;; f is in dir but not in the working directory
@ -116,10 +116,10 @@
(define (cleanup-all-submissions)
(log-line "Cleaning up all submission directories")
(for ([pset (get-conf 'all-dirs)]
(for ([pset (in-list (get-conf 'all-dirs))]
#:when (directory-exists? pset)) ; just in case
(parameterize ([current-directory pset])
(for ([sub (directory-list)]
(for ([sub (in-list (directory-list))]
#:when (directory-exists? sub)) ; filter non-dirs
(cleanup-submission sub)))))
@ -370,7 +370,7 @@
(error* "the username \"checker.ss\" is reserved"))
(when (get-user-data username)
(error* "username already exists: `~a'" username))
(for ([str extra-fields]
(for ([str (in-list extra-fields)]
[info (get-conf 'extra-fields)])
(check-field str (cadr info) (car info) (caddr info)))
(wait-for-lock "+newuser+")
@ -397,8 +397,8 @@
(error* "changing information not allowed: ~a" username))
(when (equal? new-data old-data)
(error* "no fields changed: ~a" username))
(for ([str (cdr new-data)]
[info (get-conf 'extra-fields)])
(for ([str (in-list (cdr new-data))]
[info (in-list (get-conf 'extra-fields))])
(check-field str (cadr info) (car info) (caddr info)))
(log-line "change info for ~a ~s -> ~s" username old-data new-data)
(unless (equal? (cdr new-data) (cdr old-data)) ; not for password change

3
collects/handin-server/private/logger.ss
View File

@ -74,5 +74,6 @@
(current-error-port
(make-logger-port
(and (get-conf 'log-output) (current-output-port))
(cond [(get-conf 'log-file) => (lambda (f) (open-output-file f #:exists 'append))]
(cond [(get-conf 'log-file)
=> (lambda (f) (open-output-file f #:exists 'append))]
[else #f]))))