use MAKE-ADDRESS to generate return addresses
This commit is contained in:
parent
9203e245bf
commit
61896c1238
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
Loading…
Reference in New Issue