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
(open surflet-requests ; SURFLET-REQUEST-URL
(open surflet-requests ; SURFLET-REQUEST-url
httpd-responses ; MAKE-RESPONSE
parse-html-forms ; PARSE-HTML-FORM-QUERY
url ; HTTP-URL-SEARCH
url ; HTTP-url-SEARCH
srfi-1 ; FILTER
surflet-handler/surflets ; SEND/SUSPEND, SEND/FINISH
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)
(p "Currently, there are " ,(state-counter) " profiles saved.")
(ul
(li (URL ,(new-profile-address new-url)
(li (url ,(new-profile-address new-url)
"Create new profile"))
(li (URL ,(result-address new-url)
(li (url ,(result-address new-url)
"Show profile results")
(br)
(surflet-form
@ -89,16 +89,16 @@
convert
convert-change-button)))
))))
(li (URL ,(reset-address new-url)
(li (url ,(reset-address new-url)
"Delete files and reset profile state.")))
(hr)
(URL ,(return-address new-url)
(url ,(return-address new-url)
"Return to administration menu leaving files and state untouched.")
(br)
(URL ,(reset-return-address new-url)
(url ,(reset-return-address new-url)
"Return to administration menu removing files and reseting state.")
(br)
(URL "/" "Return to main menu."))))))
(url "/" "Return to main menu."))))))
(bindings (get-bindings req)))
(cond
((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"
" chart with convert (" ,convert ")."
" Anyway, you can download the "
(URL ,gnuplot-picture-name "raw profiling chart") "."))
`(URL ,gnuplot-picture-name "Profiling chart."))
(url ,gnuplot-picture-name "raw profiling chart") "."))
`(url ,gnuplot-picture-name "Profiling chart."))
`(p "An error occured while generating the profiling results picture."
(br)
"Are you sure, you have " (q "gnuplot")
@ -253,8 +253,8 @@ plot '~a' title 'SUrflet Profiling ~a' with lines"
(iota (length results))
results))
(hr)
(p (URL ,(return-address new-url) "Return to previous page") (br)
(URL ,(reset-return-address new-url)
(p (url ,(return-address new-url) "Return to previous page") (br)
(url ,(reset-return-address new-url)
"Delete files, reset state and return to main menu.")))))))
(define (reset req)

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

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

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

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