use MAKE-ADDRESS to generate return addresses

This commit is contained in:
interp 2002-10-02 20:15:54 +00:00
parent 9203e245bf
commit 61896c1238
2 changed files with 21 additions and 17 deletions

View File

@ -9,7 +9,7 @@
) )
(begin (begin
(define (get-option-change number-field update-text) (define (get-option-change number-field return-address update-text)
(send-html/suspend (send-html/suspend
(lambda (new-url) (lambda (new-url)
`(html `(html
@ -25,7 +25,7 @@
(td ,number-field) (td ,number-field)
(td ,(make-submit-button "Change"))))) (td ,(make-submit-button "Change")))))
(hr) (hr)
(URL ,(string-append new-url "?return=") "Return to main page"))) (URL ,(return-address new-url) "Return to main page")))
))) )))
(define (handler-options req . maybe-update-text) (define (handler-options req . maybe-update-text)
@ -33,11 +33,11 @@
,(:optional maybe-update-text ""))) ,(:optional maybe-update-text "")))
(number-field (number-field
(make-number-input-field `(@ ((value ,(options-instance-lifetime)))))) (make-number-input-field `(@ ((value ,(options-instance-lifetime))))))
(req (get-option-change number-field update-text)) (return-address (make-address))
(req (get-option-change number-field return-address update-text))
(bindings (get-bindings req))) (bindings (get-bindings req)))
(format #t "bindings ~s~%" bindings)
(cond (cond
((assoc "return" bindings) ((returned-via? return-address bindings)
(return-to-main-page req)) (return-to-main-page req))
(else (else

View File

@ -21,6 +21,11 @@
(let* ((update-text (:optional maybe-update-text "")) (let* ((update-text (:optional maybe-update-text ""))
(input-field (make-text-input-field gnuplot '(@ (size 20)))) (input-field (make-text-input-field gnuplot '(@ (size 20))))
(change-button (make-submit-button "Change")) (change-button (make-submit-button "Change"))
(new-profile-address (make-address))
(result-address (make-address))
(reset-address (make-address))
(return-address (make-address))
(reset-return-address (make-address))
(req (req
(send-html/suspend (send-html/suspend
(lambda (new-url) (lambda (new-url)
@ -31,34 +36,34 @@
(font (@ (color "red")) ,update-text) (font (@ (color "red")) ,update-text)
(p "Currently, there are " ,counter " profiles saved.") (p "Currently, there are " ,counter " profiles saved.")
(ul (ul
(li (URL ,(string-append new-url "?newprofile=") (li (URL ,(new-profile-address new-url)
"Create new profile") "Create new profile")
(li (URL ,(string-append new-url "?result=") (li (URL ,(result-address new-url)
"Show profile results") "Show profile results")
(br) (br)
(servlet-form (servlet-form
,new-url ,new-url
(p "This uses " (var "gnuplot") " that is searched at " (p "This uses " (var "gnuplot") " that is searched at "
,input-field ,change-button))) ,input-field ,change-button)))
(li (URL ,(string-append new-url "?delete_reset=") (li (URL ,(reset-address new-url)
"Delete files and reset profile state.")))) "Delete files and reset profile state."))))
(hr) (hr)
(URL ,(string-append new-url "?return=") (URL ,(return-address new-url)
"Return to main page leaving profile state untouched.") "Return to main page leaving profile state untouched.")
(br) (br)
(URL ,(string-append new-url "?reset_return=") (URL ,(reset-return-address new-url)
"Return to main page reseting profile-state")))))) "Return to main page reseting profile-state"))))))
(bindings (get-bindings req))) (bindings (get-bindings req)))
(cond (cond
((assoc "newprofile" bindings) ((returned-via? new-profile-address bindings)
(new-profile req)) (new-profile req))
((assoc "result" bindings) ((returned-via? result-address bindings)
(result req)) (result req))
((assoc "delete_reset" bindings) ((returned-via? reset-address bindings)
(reset req)) (reset req))
((assoc "return" bindings) ((returned-via? return-address bindings)
(reset req)) (return-to-main-page req))
((assoc "reset_return" bindings) ((returned-via? reset-return-address bindings)
(reset-and-return-to-main-page req)) (reset-and-return-to-main-page req))
(else (else
(let ((new-gnuplot-location (with-fatal-error-handler (let ((new-gnuplot-location (with-fatal-error-handler
@ -81,7 +86,6 @@
(let ((results (profile-results file-name)) (let ((results (profile-results file-name))
(gnuplot-data-file-name (create-temp-file "servlet-profiling.data")) (gnuplot-data-file-name (create-temp-file "servlet-profiling.data"))
(picture-file (create-temp-file "servlet-profiling.picture"))) (picture-file (create-temp-file "servlet-profiling.picture")))
(format #t "results: ~a~%" results)
(write-gnuplot-data-file gnuplot-data-file-name (write-gnuplot-data-file gnuplot-data-file-name
(lambda (space-info) (lambda (space-info)
(total-bytes (space-info-total space-info))) (total-bytes (space-info-total space-info)))