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