From 9203e245bf69790eb5f9297cef38d8597e075dba Mon Sep 17 00:00:00 2001 From: interp Date: Wed, 2 Oct 2002 19:13:14 +0000 Subject: [PATCH] Don't use callbacks -- use several submit buttons or special return addresses. --- .../root/surflets/admin-handler.scm | 34 +++++--- .../root/surflets/admin-profiling.scm | 80 +++++++++++-------- .../web-server/root/surflets/byte-input.scm | 2 +- .../web-server/root/surflets/calculate.scm | 2 +- 4 files changed, 71 insertions(+), 47 deletions(-) diff --git a/scheme/httpd/surflets/web-server/root/surflets/admin-handler.scm b/scheme/httpd/surflets/web-server/root/surflets/admin-handler.scm index da9f32f..d5afdd8 100644 --- a/scheme/httpd/surflets/web-server/root/surflets/admin-handler.scm +++ b/scheme/httpd/surflets/web-server/root/surflets/admin-handler.scm @@ -25,7 +25,7 @@ (td ,number-field) (td ,(make-submit-button "Change"))))) (hr) - (URL ,(make-callback return-to-main-page) "Return to main page"))) + (URL ,(string-append new-url "?return=") "Return to main page"))) ))) (define (handler-options req . maybe-update-text) @@ -33,18 +33,26 @@ ,(:optional maybe-update-text ""))) (number-field (make-number-input-field `(@ ((value ,(options-instance-lifetime)))))) - (req (get-option-change number-field update-text))) - (with-fatal-error-handler - (lambda (condition more) - (handler-options req "Please enter a valid, positive integer number")) - (set-options-instance-lifetime - (let ((result (input-field-value number-field (get-bindings req)))) - (if (and (integer? result) - (> result 0)) - (handler-options req - (format #f "Instance lifetime changed to ~a." - (options-instance-lifetime))) - (error "not a positive integer"))))))) + (req (get-option-change number-field update-text)) + (bindings (get-bindings req))) + (format #t "bindings ~s~%" bindings) + (cond + ((assoc "return" bindings) + (return-to-main-page req)) + (else + + (with-fatal-error-handler + (lambda (condition more) + (handler-options req "Please enter a valid, positive integer number")) + (let ((result (input-field-value number-field bindings))) + (if (and (integer? result) + (> result 0)) + (begin + (set-options-instance-lifetime result) + (handler-options req + (format #f "Instance lifetime changed to ~a." + (options-instance-lifetime)))) + (error "not a positive integer")))))))) (define (return-to-main-page req) (send/finish (make-http-error-response http-status/moved-perm req diff --git a/scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm b/scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm index bd66bca..1a21937 100644 --- a/scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm +++ b/scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm @@ -17,16 +17,10 @@ (define counter 0) (define gnuplot "/usr/bin/gnuplot") - (define (reset-profiling-state!) - (set! counter 0) - (for-each delete-file file-names-to-delete) - (delete-file file-name) - (set! file-name (create-temp-file "servlet-profiling")) - (set! file-names-to-delete '())) - (define (profile req . maybe-update-text) (let* ((update-text (:optional maybe-update-text "")) (input-field (make-text-input-field gnuplot '(@ (size 20)))) + (change-button (make-submit-button "Change")) (req (send-html/suspend (lambda (new-url) @@ -37,31 +31,46 @@ (font (@ (color "red")) ,update-text) (p "Currently, there are " ,counter " profiles saved.") (ul - (li (URL ,(make-callback new-profile) "Create new profile")) - (li (URL ,(make-callback result) "Show profile results") + (li (URL ,(string-append new-url "?newprofile=") + "Create new profile") + (li (URL ,(string-append new-url "?result=") + "Show profile results") (br) (servlet-form ,new-url (p "This uses " (var "gnuplot") " that is searched at " - ,input-field ,(make-submit-button "Change")))) - (li (URL ,(make-callback reset) "Delete files and reset profile state."))) - (hr) - (URL ,(make-callback return-to-main-page) - "Return to main page leaving profile state untouched.") - (br) - (URL ,(make-callback reset-and-return-to-main-page) - "Return to main page reseting profile-state")))))) + ,input-field ,change-button))) + (li (URL ,(string-append new-url "?delete_reset=") + "Delete files and reset profile state.")))) + (hr) + (URL ,(string-append new-url "?return=") + "Return to main page leaving profile state untouched.") + (br) + (URL ,(string-append new-url "?reset_return=") + "Return to main page reseting profile-state")))))) (bindings (get-bindings req))) - (let ((new-gnuplot-location (with-fatal-error-handler - (lambda (condition more) - #f) - (input-field-value input-field bindings)))) - (if (and new-gnuplot-location - (file-executable? new-gnuplot-location)) - (begin - (set! gnuplot new-gnuplot-location) - (profile req (format #f "Gnuplot is now searched at ~a." gnuplot))) - (profile req "Please enter a file name of an existing executable."))))) + (cond + ((assoc "newprofile" bindings) + (new-profile req)) + ((assoc "result" bindings) + (result req)) + ((assoc "delete_reset" bindings) + (reset req)) + ((assoc "return" bindings) + (reset req)) + ((assoc "reset_return" bindings) + (reset-and-return-to-main-page req)) + (else + (let ((new-gnuplot-location (with-fatal-error-handler + (lambda (condition more) + #f) + (input-field-value input-field bindings)))) + (if (and new-gnuplot-location + (file-executable? new-gnuplot-location)) + (begin + (set! gnuplot new-gnuplot-location) + (profile req (format #f "Gnuplot is now searched at ~a." gnuplot))) + (profile req "Please enter a file name of an existing executable."))))))) (define (new-profile req) (profile-space file-name) @@ -105,15 +114,22 @@ plot '~a' title 'Servlet Profiling ~a' with lines" (define (reset req) (reset-profiling-state!) - (profile req)) + (profile req "Profiling state reseted.")) - (define (return-to-main-page req) - (send/finish (make-http-error-response http-status/moved-perm req - "admin.scm" "admin.scm"))) + (define (reset-profiling-state!) + (set! counter 0) + (for-each delete-filesys-object file-names-to-delete) + (delete-filesys-object file-name) + (set! file-name (create-temp-file "servlet-profiling")) + (set! file-names-to-delete '())) (define (reset-and-return-to-main-page req) (reset-profiling-state!) - (return-to-main-page req)) + (return-to-main-page req)) + + (define (return-to-main-page req) + (send/finish (make-http-error-response http-status/moved-perm req + "admin.scm" "admin.scm"))) (define (main req) (profile req)) diff --git a/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm b/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm index e0890a4..17155f7 100644 --- a/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm +++ b/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm @@ -7,7 +7,7 @@ scheme) (begin - ;; This uses callbacks. + ;; This doesn't use c-a-l-l-b-a-c-k-s anymore. (define (make-byte-input-fields bits) (let ((checkboxes diff --git a/scheme/httpd/surflets/web-server/root/surflets/calculate.scm b/scheme/httpd/surflets/web-server/root/surflets/calculate.scm index 0c7ab56..109f564 100644 --- a/scheme/httpd/surflets/web-server/root/surflets/calculate.scm +++ b/scheme/httpd/surflets/web-server/root/surflets/calculate.scm @@ -7,7 +7,7 @@ scheme) (begin - ;; This doesn't use callbacks anymore. + ;; This doesn't use c-a-l-l-b-a-c-k-s anymore. (define *operator-alist* `(("+" . ,+)