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

URL -> url

This commit is contained in:
mainzelm 2003-03-10 09:23:41 +00:00
parent 3b51f7b82b
commit 5c03d2e24e
4 changed files with 38 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
scheme/httpd/surflets/web-server/root/surflets/add-raw.scm
View File

@ -1,8 +1,8 @@
(define-structure surflet surflet-interface (define-structure surflet surflet-interface
(open surflet-requests ; SURFLET-REQUEST-URL (open surflet-requests ; SURFLET-REQUEST-url
httpd-responses ; MAKE-RESPONSE httpd-responses ; MAKE-RESPONSE
parse-html-forms ; PARSE-HTML-FORM-QUERY parse-html-forms ; PARSE-HTML-FORM-QUERY
url ; HTTP-URL-SEARCH url ; HTTP-url-SEARCH
srfi-1 ; FILTER srfi-1 ; FILTER
surflet-handler/surflets ; SEND/SUSPEND, SEND/FINISH surflet-handler/surflets ; SEND/SUSPEND, SEND/FINISH
surflet-handler/responses ; MAKE-SURFLET-RESPONSE surflet-handler/responses ; MAKE-SURFLET-RESPONSE

20
scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm
View File

@ -62,9 +62,9 @@
,(emph update-text) ,(emph update-text)
(p "Currently, there are " ,(state-counter) " profiles saved.") (p "Currently, there are " ,(state-counter) " profiles saved.")
(ul (ul
(li (URL ,(new-profile-address new-url) (li (url ,(new-profile-address new-url)
"Create new profile")) "Create new profile"))
(li (URL ,(result-address new-url) (li (url ,(result-address new-url)
"Show profile results") "Show profile results")
(br) (br)
(surflet-form (surflet-form
@ -89,16 +89,16 @@
convert convert
convert-change-button))) convert-change-button)))
)))) ))))
(li (URL ,(reset-address new-url) (li (url ,(reset-address new-url)
"Delete files and reset profile state."))) "Delete files and reset profile state.")))
(hr) (hr)
(URL ,(return-address new-url) (url ,(return-address new-url)
"Return to administration menu leaving files and state untouched.") "Return to administration menu leaving files and state untouched.")
(br) (br)
(URL ,(reset-return-address new-url) (url ,(reset-return-address new-url)
"Return to administration menu removing files and reseting state.") "Return to administration menu removing files and reseting state.")
(br) (br)
(URL "/" "Return to main menu.")))))) (url "/" "Return to main menu."))))))
(bindings (get-bindings req))) (bindings (get-bindings req)))
(cond (cond
((returned-via? new-profile-address bindings) ((returned-via? new-profile-address bindings)
@ -237,8 +237,8 @@ plot '~a' title 'SUrflet Profiling ~a' with lines"
`(p "An error occured while generating the profiling results" `(p "An error occured while generating the profiling results"
" chart with convert (" ,convert ")." " chart with convert (" ,convert ")."
" Anyway, you can download the " " Anyway, you can download the "
(URL ,gnuplot-picture-name "raw profiling chart") ".")) (url ,gnuplot-picture-name "raw profiling chart") "."))
`(URL ,gnuplot-picture-name "Profiling chart.")) `(url ,gnuplot-picture-name "Profiling chart."))
`(p "An error occured while generating the profiling results picture." `(p "An error occured while generating the profiling results picture."
(br) (br)
"Are you sure, you have " (q "gnuplot") "Are you sure, you have " (q "gnuplot")
@ -253,8 +253,8 @@ plot '~a' title 'SUrflet Profiling ~a' with lines"
(iota (length results)) (iota (length results))
results)) results))
(hr) (hr)
(p (URL ,(return-address new-url) "Return to previous page") (br) (p (url ,(return-address new-url) "Return to previous page") (br)
(URL ,(reset-return-address new-url) (url ,(reset-return-address new-url)
"Delete files, reset state and return to main menu."))))))) "Delete files, reset state and return to main menu.")))))))
(define (reset req) (define (reset req)

34
scheme/httpd/surflets/web-server/root/surflets/admin-surflets.scm
View File

@ -73,9 +73,9 @@
(define (no-surflets) (define (no-surflets)
`(p "Currently, there are no SUrflets loaded " `(p "Currently, there are no SUrflets loaded "
(URL ,(make-callback show-surflets) "(reload)") (url ,(make-callback show-surflets) "(reload)")
", but there may be " ", but there may be "
(URL ,(make-callback show-sessions) "sessions") (url ,(make-callback show-sessions) "sessions")
" you want to administer.")) " you want to administer."))
(define (show-surflets req . maybe-update-text) (define (show-surflets req . maybe-update-text)
@ -87,9 +87,9 @@
(h2 "SUrflets") (h2 "SUrflets")
(p (font (@ (color "red")) ,update-text)))) (p (font (@ (color "red")) ,update-text))))
(footer `((hr) (footer `((hr)
(URL ,(make-callback return-to-main-page) "Return to administration menu.") (url ,(make-callback return-to-main-page) "Return to administration menu.")
(br) (br)
(URL "/" "Return to main menu."))) (url "/" "Return to main menu.")))
(actions '("unload" "unload all"))) (actions '("unload" "unload all")))
(if (null? loaded-surflets) (if (null? loaded-surflets)
(send-html `(html (title ,title) (body ,header ,(no-surflets) ,footer))) (send-html `(html (title ,title) (body ,header ,(no-surflets) ,footer)))
@ -106,7 +106,7 @@
`(p "Note that unloading the SUrflets does not imply " `(p "Note that unloading the SUrflets does not imply "
"the unloading of sessions of this SUrflet. " (br) "the unloading of sessions of this SUrflet. " (br)
"This can be done on the " "This can be done on the "
(URL ,(make-callback show-sessions) (url ,(make-callback show-sessions)
"sessions adminstration page.")) "sessions adminstration page."))
footer)) footer))
(if (not action) (if (not action)
@ -145,7 +145,7 @@
'(p "Currently, there are no sessions, " '(p "Currently, there are no sessions, "
"i.e. the administration SUrflet is no longer running. " "i.e. the administration SUrflet is no longer running. "
;; Can't use callback here, as there are no valid sessions left. ;; Can't use callback here, as there are no valid sessions left.
(URL "admin.scm" "Go back to main page."))) (url "admin.scm" "Go back to main page.")))
(define (show-sessions req . maybe-update-text) (define (show-sessions req . maybe-update-text)
(let* ((update-text (:optional maybe-update-text "")) (let* ((update-text (:optional maybe-update-text ""))
@ -164,10 +164,10 @@
"session (id: " ,this-session-id ").") "session (id: " ,this-session-id ").")
#f) #f)
(hr) (hr)
(URL ,(make-callback show-surflets) "Return to SUrflets menu.") (br) (url ,(make-callback show-surflets) "Return to SUrflets menu.") (br)
(URL ,(make-callback return-to-main-page) "Return to administration menu.") (url ,(make-callback return-to-main-page) "Return to administration menu.")
(br) (br)
(URL "/" "Return to main menu."))) (url "/" "Return to main menu.")))
(actions '("kill" (actions '("kill"
"adjust timeout" "adjust timeout"
"view continuations")) "view continuations"))
@ -218,11 +218,11 @@
(define (no-current-continuations session req) (define (no-current-continuations session req)
`((p "Currently, there are no continuations for this session. ") `((p "Currently, there are no continuations for this session. ")
(p "You may " (URL ,(make-callback (p "You may " (url ,(make-callback
(lambda (req) (show-continuations (list session) req))) (lambda (req) (show-continuations (list session) req)))
"reload") "reload")
" this page or go back to the " " this page or go back to the "
(URL ,(make-callback show-sessions) "session table overview.")))) (url ,(make-callback show-sessions) "session table overview."))))
(define (no-more-than-one-session title header1 sessions req) (define (no-more-than-one-session title header1 sessions req)
(send-html (send-html
@ -232,13 +232,13 @@
"one session at a time. This will be changed in " "one session at a time. This will be changed in "
"future revisions. Sorry for any inconvenience.") "future revisions. Sorry for any inconvenience.")
(p "You may choose to go back to the " (p "You may choose to go back to the "
(URL ,(make-callback show-sessions) (url ,(make-callback show-sessions)
"sessions administration page") "sessions administration page")
" where you can select one session" " where you can select one session"
" or select one session from your chosen sessions:" (br) " or select one session from your chosen sessions:" (br)
(ul (ul
,@(map (lambda (session) ,@(map (lambda (session)
`(li (URL ,(make-callback `(li (url ,(make-callback
(lambda (req) (lambda (req)
(show-continuations (list session) req))) (show-continuations (list session) req)))
,(session-surflet-name (cdr session)) ,(session-surflet-name (cdr session))
@ -274,11 +274,11 @@
"continuation (id: " ,this-continuation-id ").") "continuation (id: " ,this-continuation-id ").")
#f) #f)
(hr) (hr)
(URL ,(make-callback show-surflets) "Return to SUrflets menu.") (br) (url ,(make-callback show-surflets) "Return to SUrflets menu.") (br)
(URL ,(make-callback show-sessions) "Return to sessions menu.") (br) (url ,(make-callback show-sessions) "Return to sessions menu.") (br)
(URL ,(make-callback return-to-main-page) "Return to administration menu.") (url ,(make-callback return-to-main-page) "Return to administration menu.")
(br) (br)
(URL "/" "Return to main menu."))) (url "/" "Return to main menu.")))
(actions '("delete" "delete all")) (actions '("delete" "delete all"))
(continuations-callback (continuations-callback
(make-callback (lambda (req) (make-callback (lambda (req)

18
scheme/httpd/surflets/web-server/root/surflets/test.scm
View File

@ -14,9 +14,9 @@
(lambda (new-url) (lambda (new-url)
`(html (body (h1 "This is from SUrflet") `(html (body (h1 "This is from SUrflet")
(p "called " ,(length global) " times") (p "called " ,(length global) " times")
(URL ,(addr new-url "ab=ba")) (br) (url ,(addr new-url "ab=ba")) (br)
(URL ,(addr new-url "be<ta")) (br) (url ,(addr new-url "be<ta")) (br)
(URL ,(addr new-url)) (br) (url ,(addr new-url)) (br)
(abba) (abba)
(surflet-form (surflet-form
,new-url ,new-url
@ -25,7 +25,7 @@
'(input (@ (type "text") (name "TeST"))) '(input (@ (type "text") (name "TeST")))
,(make-submit-button)) ,(make-submit-button))
(hr) (hr)
(p (URL "/" "Return to main menu.")) (p (url "/" "Return to main menu."))
))))) )))))
(save-k #f) (save-k #f)
(done? #f) (done? #f)
@ -51,10 +51,10 @@
`(html (body (h1 "Result") `(html (body (h1 "Result")
(p "called " ,(length global) " times") (p "called " ,(length global) " times")
,result (br) ,result (br)
(URL ,continue "show results again") (url ,continue "show results again")
(hr) (hr)
(p (URL "test.scm" "Test again.") (br) (p (url "test.scm" "Test again.") (br)
(URL "/" "Return to main menu.")))))) (url "/" "Return to main menu."))))))
(set! done? #t) (set! done? #t)
(save-k 13)) (save-k 13))
@ -64,7 +64,7 @@
(p "called " ,(length global) " times") (p "called " ,(length global) " times")
,(format #f "~s" (get-bindings req)) ,(format #f "~s" (get-bindings req))
(hr) (hr)
(p (URL "test.scm" "Test again.") (br) (p (url "test.scm" "Test again.") (br)
(URL "/" "Return to main menu.")))))))) (url "/" "Return to main menu."))))))))
)) ))