scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Simplify.

This commit is contained in:
interp 2004-07-29 17:24:52 +00:00
parent 2f0b9d0b50
commit 4a789540c9
1 changed files with 3 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
web-server/root/surflets/admin-handler.scm
View File

@ -8,7 +8,7 @@
) )
(begin (begin
(define (get-option-change return-address update-text options) (define (get-option-change update-text options)
(send-html/suspend (send-html/suspend
(lambda (new-url) (lambda (new-url)
`(html `(html
@ -31,14 +31,12 @@
(td ,submit-button)))) (td ,submit-button))))
options))) options)))
(hr) (hr)
(p (url ,(return-address new-url) "Return to adminstration menu.") (br) (p (url "admin.scm" "Return to adminstration menu.") (br)
(url "/" "Return to main menu.")))) (url "/" "Return to main menu."))))
))) )))
(define submit-timeout (make-submit-button "Change")) (define submit-timeout (make-submit-button "Change"))
(define return-address (make-address))
(define submit-cache (make-submit-button "Change")) (define submit-cache (make-submit-button "Change"))
(define (handler-options req . maybe-update-text) (define (handler-options req . maybe-update-text)
(let* ((update-text `(font (@ (color "red")) (let* ((update-text `(font (@ (color "red"))
@ -48,11 +46,9 @@
(cache-checkbox (make-checkbox (options-cache-surflets?))) (cache-checkbox (make-checkbox (options-cache-surflets?)))
(options `(("Current session lifetime: " ,number-field ,submit-timeout) (options `(("Current session lifetime: " ,number-field ,submit-timeout)
("Cache SUrflets?" ,cache-checkbox ,submit-cache))) ("Cache SUrflets?" ,cache-checkbox ,submit-cache)))
(req (get-option-change return-address update-text options)) (req (get-option-change update-text options))
(bindings (get-bindings req))) (bindings (get-bindings req)))
(cond (cond
((returned-via? return-address bindings)
(return-to-main-page req))
((returned-via? submit-timeout bindings) ((returned-via? submit-timeout bindings)
(let ((result (input-field-value number-field bindings))) (let ((result (input-field-value number-field bindings)))
(if result (if result
@ -74,11 +70,6 @@
(else (else
(error "unexpected return" bindings))))) (error "unexpected return" bindings)))))
(define (return-to-main-page req)
(send-error (status-code moved-perm) req
"admin.scm" "admin.scm"))
(define (main req) (define (main req)
(handler-options req)) (handler-options req))