suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

misc improvements

Browse Source 
svn: r7191
This commit is contained in:
Eli Barzilay 2007-08-27 04:07:47 +00:00
parent 4b7a9ce822
commit 3532652539
28 changed files with 420 additions and 396 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/help/servlets/acknowledge.ss
View File

@ -9,11 +9,9 @@
(with-errors-to-browser (with-errors-to-browser
send/finish send/finish
(lambda () (lambda ()
(html-page (html-page
#:title "Acknowledgements" #:title "Acknowledgements"
#:bodies `((a ([name "acknowledgements"] [value "acknowledgements"])) #:bodies `((a ([name "acknowledgements"] [value "acknowledgements"]))
(h1 "Acknowledgements") (h1 "Acknowledgements")
(p) (p ,(get-general-acks))
,(get-general-acks) (p ,(get-translating-acks))))))))
(p)
,(get-translating-acks)))))))

1
collects/help/servlets/doc-anchor.ss
View File

@ -16,4 +16,3 @@
(extract-binding/single 'caption bindings) (extract-binding/single 'caption bindings)
(extract-binding/single 'name bindings) (extract-binding/single 'name bindings)
offset)))))) offset))))))

7
collects/help/servlets/doc-content.ss
View File

@ -15,8 +15,5 @@
[offset (with-handlers ((void (lambda _ #f))) [offset (with-handlers ((void (lambda _ #f)))
(string->number (string->number
(extract-binding/single 'offset bindings)))]) (extract-binding/single 'offset bindings)))])
`(html (head (title "PLT Help Desk") `(html (head (title "PLT Help Desk") ,hd-css ,@hd-links)
,hd-css ,(read-lines file caption offset)))))))
,@hd-links)
,(read-lines file caption offset)))))))

1
collects/help/servlets/doc-message.ss
View File

@ -14,4 +14,3 @@
(body ,(format-collection-message (body ,(format-collection-message
(extract-binding/single 'msg bindings)) (extract-binding/single 'msg bindings))
(hr)))))))) (hr))))))))

57
collects/help/servlets/home.ss
View File

@ -56,8 +56,7 @@
" what is installed on this HelpDesk server only.")) " what is installed on this HelpDesk server only."))
'()) '())
(VERBATIM ,(find-manuals)) (VERBATIM ,(find-manuals))
(p) (p (i "Version: " ,(plt-version)))))]
(i "Version: " ,(plt-version))))]
["release" ["release"
(let ([link-stuff (lambda (url txt) (let ([link-stuff (lambda (url txt)
`(li (b (a ([href ,url]) ,txt))))]) `(li (b (a ([href ,url]) ,txt))))])
@ -77,8 +76,7 @@
,(link-stuff url-helpdesk-known-bugs "Known Bugs") ,(link-stuff url-helpdesk-known-bugs "Known Bugs")
,(link-stuff url-helpdesk-patches "Downloadable Patches")) ,(link-stuff url-helpdesk-patches "Downloadable Patches"))
(p "The PLT software is installed on this machine at" (br) (p "The PLT software is installed on this machine at" (br)
(pre nbsp nbsp (pre nbsp nbsp ,(path->string (find-collects-dir)))))))))]
,(path->string (find-collects-dir)))))))))]
[_ [_
(let-values ([(right-header right-items) (let-values ([(right-header right-items)
(page-tag->title+items subpage)]) (page-tag->title+items subpage)])
@ -91,8 +89,7 @@
"home" "home"
right-header right-header
(append (left-items) (append (left-items)
`(((p) `(((p (i "Version: " ,(plt-version)))))))]
(i "Version: " ,(plt-version))))))]
[else [else
(html-subpage "PLT Scheme Help Desk: Home" (html-subpage "PLT Scheme Help Desk: Home"
(html-top initial-request) (html-top initial-request)
@ -173,13 +170,16 @@
`(("acknowledge" "Acknowledgements" `(("acknowledge" "Acknowledgements"
((p ,(get-general-acks)) ((p ,(get-general-acks))
(p ,(get-translating-acks)))) (p ,(get-translating-acks))))
;;
("books" "Books" ("books" "Books"
((h3 "HTDP - How to Design Programs") ((h3 "HTDP - How to Design Programs")
(p (a ((href "http://www.htdp.org/")) (p (a ([href "http://www.htdp.org/"])
"'How to Design Programs - An Introduction to Programming and Computing'") "'How to Design Programs -"
" An Introduction to Programming and Computing'")
(br) (br)
" by Matthias Felleisen, Robert Bruce Findler, Matthew Flatt, and Shriram Krishnamurthi") " by Matthias Felleisen, Robert Bruce Findler, Matthew Flatt, and Shriram Krishnamurthi")
(p (a ((href "http://www.ccs.neu.edu/home/matthias/htdp-plus.html")) "HTDP+") (p (a ([href "http://www.ccs.neu.edu/home/matthias/htdp-plus.html"])
"HTDP+")
(br) (br)
" Supplemental Materials for 'How to Design Programs'") " Supplemental Materials for 'How to Design Programs'")
(h3 "Teach Yourself Scheme in Fixnum Days") (h3 "Teach Yourself Scheme in Fixnum Days")
@ -187,15 +187,25 @@
" Teach Yourself Scheme in Fixnum Days") " Teach Yourself Scheme in Fixnum Days")
(br) (br)
"- an introduction to Scheme by Dorai Sitaram"))) "- an introduction to Scheme by Dorai Sitaram")))
;;
("drscheme" "DrScheme" ("drscheme" "DrScheme"
((p "DrScheme is PLT's flagship programming environment") ((p "DrScheme is PLT's flagship programming environment")
(ul (li (a ((href ,url-helpdesk-tour)) (b "Tour: ") "An introduction to DrScheme")) (ul (li (a ([href ,url-helpdesk-tour])
(li (a ((href ,url-helpdesk-interface-essentials)) "Quick-start jump into the user manual")) (b "Tour: ") "An introduction to DrScheme"))
(li (a ((href ,url-helpdesk-languages)) "Languages: ") "supported by DrScheme") (li (a ([href ,url-helpdesk-interface-essentials])
(li (a ((href ,url-helpdesk-drscheme-manual)) "PLT DrScheme: Programming Environment Manual") "Quick-start jump into the user manual"))
(br) "The complete user manual") (li (a ([href ,url-helpdesk-languages])
(li (a ((href ,url-helpdesk-drscheme-faq)) "FAQ") ": DrScheme Frequently asked questions") "Languages: ")
(li (a ((href ,url-helpdesk-why-drscheme)) "Why DrScheme?"))))) "supported by DrScheme")
(li (a ([href ,url-helpdesk-drscheme-manual])
"PLT DrScheme: Programming Environment Manual")
(br)
"The complete user manual")
(li (a ([href ,url-helpdesk-drscheme-faq]) "FAQ")
": DrScheme Frequently asked questions")
(li (a ([href ,url-helpdesk-why-drscheme])
"Why DrScheme?")))))
;;
("home" "Help Desk Home" ("home" "Help Desk Home"
((p "The HelpDesk is a complete source of information about PLT software, " ((p "The HelpDesk is a complete source of information about PLT software, "
"including DrScheme, MzScheme and MrEd.") "including DrScheme, MzScheme and MrEd.")
@ -211,11 +221,13 @@
(ul (li "The " (b "Home") " link will take you back to this page.") (ul (li "The " (b "Home") " link will take you back to this page.")
(li "The " (b "Manuals") " link displays a list of manuals and other documentation") (li "The " (b "Manuals") " link displays a list of manuals and other documentation")
#;(li "The " (b "Send a bug report") " link allows you to submit a bug report to PLT.")))) #;(li "The " (b "Send a bug report") " link allows you to submit a bug report to PLT."))))
;;
("known-bugs" "Known Bugs" ("known-bugs" "Known Bugs"
((p (a ([name "bugs"] [value "Bugs"])) ((p (a ([name "bugs"] [value "Bugs"]))
"For an up-to-date list of bug reports, see the " "For an up-to-date list of bug reports, see the "
(a ([href "http://bugs.plt-scheme.org/query/"] [target "_top"]) (a ([href "http://bugs.plt-scheme.org/query/"] [target "_top"])
"PLT bug report query page") "."))) "PLT bug report query page") ".")))
;;
("languages" "Scheme Languages" ("languages" "Scheme Languages"
((p "DrScheme supports many dialects of Scheme. " ((p "DrScheme supports many dialects of Scheme. "
"The following dialects are specifically designed for teaching " "The following dialects are specifically designed for teaching "
@ -255,6 +267,7 @@
(p "DrScheme's set of languages can be extended, so the above list mentions only " (p "DrScheme's set of languages can be extended, so the above list mentions only "
"the languages installed by default. " "the languages installed by default. "
"Documentation for all languages is available through the manuals page."))) "Documentation for all languages is available through the manuals page.")))
;;
("libraries" "Libraries" ("libraries" "Libraries"
((h3 "Built-in Libraries") ((h3 "Built-in Libraries")
(p "PLT Scheme has a lot of libraries. The core libraries are described in " (p "PLT Scheme has a lot of libraries. The core libraries are described in "
@ -263,6 +276,7 @@
(h3 "User / PLaneT Libraries") (h3 "User / PLaneT Libraries")
(p (a ((href ,url-external-planet)) "PLaneT") " is the repository for user contributed libraries. " (p (a ((href ,url-external-planet)) "PLaneT") " is the repository for user contributed libraries. "
"Join the PLaneT announcement mailing list to get notified on new PLaneT packages."))) "Join the PLaneT announcement mailing list to get notified on new PLaneT packages.")))
;;
("license" "License" ("license" "License"
((a ([name "lic"] [value "License"])) ((a ([name "lic"] [value "License"]))
(b "PLT Software") (br) (b "PLT Software") (br)
@ -337,6 +351,7 @@
"Copyright (c) 1994, 1995, 1996, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.") "Copyright (c) 1994, 1995, 1996, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.")
("GNU Classpath" ("GNU Classpath"
"GNU Public License with special exception")))))) "GNU Public License with special exception"))))))
;;
("mailing-lists" "Mailing Lists" ("mailing-lists" "Mailing Lists"
((p "There are two mailing lists: the discussion list and the announcements only list.") ((p "There are two mailing lists: the discussion list and the announcements only list.")
(h3 "Archives") (h3 "Archives")
@ -349,6 +364,7 @@
(a ((href ,url-external-mailing-list-subscription)) (a ((href ,url-external-mailing-list-subscription))
"subscription page") "subscription page")
" to join the mailing lists."))) " to join the mailing lists.")))
;;
("patches" "Downloadable Patches" ("patches" "Downloadable Patches"
((p (a ([name "patches"] [value "Downloadable patches"])) ((p (a ([name "patches"] [value "Downloadable patches"]))
"The following Web page may contain downloadable patches to fix " "The following Web page may contain downloadable patches to fix "
@ -357,6 +373,7 @@
,(let ([url (format "http://download.plt-scheme.org/patches/~a/" ,(let ([url (format "http://download.plt-scheme.org/patches/~a/"
(version))]) (version))])
`(a ([href ,url] [target "_top"]) ,url))))) `(a ([href ,url] [target "_top"]) ,url)))))
;;
("program-design" "Program Design" ("program-design" "Program Design"
((h3 "For Students") ((h3 "For Students")
(p "The textbook " (a ((href "http://www.htdp.org")) "How to Design Programs") (p "The textbook " (a ((href "http://www.htdp.org")) "How to Design Programs")
@ -368,6 +385,7 @@
": For programmers with lots of experience in other languages") ": For programmers with lots of experience in other languages")
(h3 "For Teachers and Researchers") (h3 "For Teachers and Researchers")
(p (a ((href ,url-helpdesk-why-drscheme)) "PLT's vision")))) (p (a ((href ,url-helpdesk-why-drscheme)) "PLT's vision"))))
;;
("release-notes" (h1 "Release Notes for PLT Scheme version " ,(version)) ("release-notes" (h1 "Release Notes for PLT Scheme version " ,(version))
((a ([name "relnotes"] [VALUE "Release notes"])) ((a ([name "relnotes"] [VALUE "Release notes"]))
(p "Detailed release notes:" (p "Detailed release notes:"
@ -395,6 +413,7 @@
("MrEd release notes" "mred" "HISTORY") ("MrEd release notes" "mred" "HISTORY")
("Stepper release notes" "stepper" "HISTORY") ("Stepper release notes" "stepper" "HISTORY")
("MrFlow release notes" "mrflow" "HISTORY"))))))))) ("MrFlow release notes" "mrflow" "HISTORY")))))))))
;;
("software" "Software" ("software" "Software"
((ul (li (a ((href ,url-helpdesk-drscheme)) "DrScheme") ": The programming environment") ((ul (li (a ((href ,url-helpdesk-drscheme)) "DrScheme") ": The programming environment")
(li (a ((href ,url-helpdesk-languages)) "Languages") ": The family of languages " (li (a ((href ,url-helpdesk-languages)) "Languages") ": The family of languages "
@ -404,11 +423,13 @@
;; (li (a ((href ,url-helpdesk-hints)) "Hints") ;; (li (a ((href ,url-helpdesk-hints)) "Hints")
;; ": How to do things in Scheme") ;; ": How to do things in Scheme")
))) )))
;;
("teachpacks" "Teachpacks" ("teachpacks" "Teachpacks"
((ul (li (a ((href ,url-helpdesk-teachpacks-for-htdp)) ((ul (li (a ((href ,url-helpdesk-teachpacks-for-htdp))
"Teachpacks for 'How to Design Programs'")) "Teachpacks for 'How to Design Programs'"))
(li (a ((href ,url-helpdesk-teachpacks-for-htdc)) (li (a ((href ,url-helpdesk-teachpacks-for-htdc))
"Teachpacks for 'How to Design Classes'"))))) "Teachpacks for 'How to Design Classes'")))))
;;
("teachscheme" "Teach Scheme" ("teachscheme" "Teach Scheme"
((h2 "TeachScheme! Workshops") ((h2 "TeachScheme! Workshops")
(p (a ([name "workshops"] [value "TeachScheme! workshops"])) (p (a ([name "workshops"] [value "TeachScheme! workshops"]))
@ -428,10 +449,12 @@
(a ([href "http://www.teach-scheme.org/Workshops/"] (a ([href "http://www.teach-scheme.org/Workshops/"]
[TARGET "_top"]) [TARGET "_top"])
"TeachScheme! Workshops page") "."))) "TeachScheme! Workshops page") ".")))
;;
("tour" "Tour of DrScheme" ("tour" "Tour of DrScheme"
((p "Take a " (a ((href ,url-external-tour-of-drscheme)) "Tour of DrScheme") ((p "Take a " (a ([href ,url-external-tour-of-drscheme]) "Tour of DrScheme")
" and discover the wealth of features of the interactive, " " and discover the wealth of features of the interactive, "
"integrated programming environment."))) "integrated programming environment.")))
;;
("why-drscheme" "Why DrScheme?" ("why-drscheme" "Why DrScheme?"
((p "Teaching introductory computing courses with Scheme, or any other " ((p "Teaching introductory computing courses with Scheme, or any other "
"functional programming language, facilitates many conceptual tasks " "functional programming language, facilitates many conceptual tasks "

12
collects/help/servlets/manual-section.ss
View File

@ -21,13 +21,11 @@
(send/finish (send/finish
(html-page (html-page
#:title "Can't find manual section" #:title "Can't find manual section"
#:bodies #:bodies
`("Error looking up PLT manual section" `("Error looking up PLT manual section"
(p) (p "Requested manual: "
"Requested manual: " ,manual (br)
,manual (br) "Requested section: "
"Requested section: " ,section)))))])
,section))))])
(finddoc-page-anchor manual section))]) (finddoc-page-anchor manual section))])
(send/finish (redirect-to page))))))) (send/finish (redirect-to page)))))))

2
collects/help/servlets/manuals.ss
View File

@ -8,4 +8,4 @@
(with-errors-to-browser (with-errors-to-browser
send/finish send/finish
(lambda () (lambda ()
(list #"text/html" (find-manuals)))))) (list #"text/html" (find-manuals))))))

31
collects/help/servlets/missing-manual.ss
View File

@ -23,21 +23,20 @@
#:title "Missing PLT manual" #:title "Missing PLT manual"
#:bodies #:bodies
`(,(with-color "red" `(h1 "Documentation missing")) `(,(with-color "red" `(h1 "Documentation missing"))
(p) (p "You tried to access documentation for "
"You tried to access documentation for " ,(with-color "blue" `(b ,label)) ". "
,(with-color "blue" `(b ,label)) ". " "The documentation is not installed on this machine, probably"
"The documentation is not installed on this machine, probably" " because it is not part of the standard DrScheme distribution.")
" because it is not part of the standard DrScheme distribution."
(p)
(h2 "Install Locally")
(a ((href ,plt-url)) "Download and/or install")
" the documentation."
(br) (br)
"After installing, " (h2 "Install Locally")
(a ((href ,link)) "continue") (p (a ([href ,plt-url]) "Download and/or install")
" to the originally requested page." " the documentation."
(br) nbsp (br) (br)
"After installing, "
(a ((href ,link)) "continue")
" to the originally requested page."
(br) nbsp (br))
(h2 "Read Online") (h2 "Read Online")
"Read the documentation on " (p "Read the documentation on "
(a ((href ,html-url)) "PLT's servers") (a ((href ,html-url)) "PLT's servers")
"."))))) "."))))))

11
collects/help/servlets/private/external.ss
View File

@ -6,9 +6,8 @@
(when (unbox external-box) (when (unbox external-box)
(show (show
`(html (head ,hd-css ,@hd-links (title "Servlet unavailable")) `(html (head ,hd-css ,@hd-links (title "Servlet unavailable"))
(body (h3 (font ([color "red"]) "Servlet unavailable")) (body (h3 (font ([color "red"]) "Servlet unavailable"))
(p) (p "Because the PLT Help Desk server is accepting external"
"Because the PLT Help Desk server is accepting external" " connections, the requested Help Desk servlet"
" connections, the requested Help Desk servlet" (blockquote (tt ,url))
(blockquote (tt ,url)) "is not available.")))))))
"is not available."))))))

2
collects/help/servlets/private/headelts.ss
View File

@ -1,4 +1,4 @@
; elements to go in HEAD part of HTML document ;; elements to go in HEAD part of HTML document
(module headelts mzscheme (module headelts mzscheme
(require (lib "list.ss")) (require (lib "list.ss"))

9
collects/help/servlets/private/html.ss
View File

@ -35,13 +35,16 @@
(meta ([http-equiv "Content-Type"] [content "text/html;charset=UTF-8"])) (meta ([http-equiv "Content-Type"] [content "text/html;charset=UTF-8"]))
(meta ([name "generator"] [content "PLT Scheme"])) (meta ([name "generator"] [content "PLT Scheme"]))
;; TODO: Ask Eli what exactly to put here in the online version ;; TODO: Ask Eli what exactly to put here in the online version
;; (script ((src "http://www.google-analytics.com/urchin.js") (type "text/javascript"))) ;; (script ([src "http://www.google-analytics.com/urchin.js"]
;; (script ((type "text/javascript")) "_uacct=\"UA-808258-1\";_udn=\"plt-scheme.org\";urchinTracker();") ;; [type "text/javascript"]))
;; (script ([type "text/javascript"])
;; "_uacct=\"UA-808258-1\";_udn=\"plt-scheme.org\";urchinTracker();")
(head (head
(title ,title) (title ,title)
(style ([type "text/css"]) "\n" ,(css)) (style ([type "text/css"]) "\n" ,(css))
;; TODO: Check the icons work in online version ;; TODO: Check the icons work in online version
(link ([rel "icon"] [href "/help/servlets/plticon.ico"] [type "image/ico"])) (link ([rel "icon"] [href "/help/servlets/plticon.ico"]
[type "image/ico"]))
(link ([rel "shortcut icon"] [href "/help/servlets/plticon.ico"]))) (link ([rel "shortcut icon"] [href "/help/servlets/plticon.ico"])))
(body ,@top ,@bodies)))) (body ,@top ,@bodies))))

8
collects/help/servlets/private/read-doc.ss
View File

@ -18,10 +18,10 @@
(html-page (html-page
#:title "PLT Help Desk" #:title "PLT Help Desk"
#:bodies (if msg #:bodies (if msg
`(,(format-collection-message msg) `(,(format-collection-message msg)
(hr) (hr)
,(read-lines file caption offset)) ,(read-lines file caption offset))
`(,(read-lines file caption offset)))))) `(,(read-lines file caption offset))))))
(define read-doc (define read-doc
(opt-lambda (file caption coll [offset #f]) (opt-lambda (file caption coll [offset #f])

2
collects/help/servlets/private/search-util.ss
View File

@ -23,5 +23,3 @@
`(("index entries" html) `(("index entries" html)
("keyword entries" text) ("keyword entries" text)
("text" text)))) ("text" text))))

189
collects/help/servlets/private/split-screen.ss
View File

@ -4,124 +4,141 @@
"html.ss" "html.ss"
"url.ss" "url.ss"
"../../private/options.ss") "../../private/options.ss")
; These items are common to all split screens ;; These items are common to all split screens
(define left-header-items (define left-header-items
`((VERBATIM (big (big (big (b (a ((href ,url-helpdesk-home)) "PLT Scheme Help Desk")))))))) `((VERBATIM (big (big (big (b (a ([href ,url-helpdesk-home])
"PLT Scheme Help Desk"))))))))
(define left-footer-items (define left-footer-items
(case (helpdesk-platform) (case (helpdesk-platform)
[(internal-browser internal-browser-simple) [(internal-browser internal-browser-simple)
'(nbsp)] '(nbsp)]
[else [else
'(nbsp '(nbsp
(VERBATIM (small (small (a ((href "http://www.plt-scheme.org/map.html")) "Site Map")))) (VERBATIM (small (small (a ([href "http://www.plt-scheme.org/map.html"])
(VERBATIM (hr ((noshade "1") (size "2") (color "#3a652b")))) "Site Map"))))
(VERBATIM (nobr (VERBATIM (hr ([noshade "1"] [size "2"] [color "#3a652b"])))
(small ((class "sansa")) (VERBATIM (nobr
(a ((href "http://www.plt-scheme.org/")) "PLT") (small ([class "sansa"])
nbsp "|" nbsp (a ([href "http://www.plt-scheme.org/"]) "PLT")
(a ((href "http://www.plt-scheme.org/software/drscheme/")) "DrScheme") nbsp "|" nbsp
nbsp "|" nbsp (a ([href "http://www.plt-scheme.org/software/drscheme/"])
(a ((href "http://www.teach-scheme.org/")) "TeachScheme!") "DrScheme")
nbsp "|" nbsp nbsp "|" nbsp
(a ((href "http://www.htdp.org/")) "HtDP") nbsp (a ([href "http://www.teach-scheme.org/"]) "TeachScheme!")
"|" nbsp nbsp "|" nbsp
(a ((href "http://planet.plt-scheme.org/")) "PLaneT") (a ([href "http://www.htdp.org/"]) "HtDP") nbsp
nbsp))) "|" nbsp
; Google Search for PLT Documentation (a ([href "http://planet.plt-scheme.org/"]) "PLaneT")
#;(VERBATIM (div ((align "center")) nbsp)))
(div ((style "display: inline; margin: 0; white-space: nowrap;")) ;; Google Search for PLT Documentation
; The Google "Search Documentation" field and button #;
(form ((id "searchbox_010927490648632664335:4yu6uuqr9ia") (VERBATIM
(action "http://www.plt-scheme.org/search/") (div ([align "center"])
(style "display: inline; margin: 0;")) (div ([style "display: inline; margin: 0; white-space: nowrap;"])
(input ((type "hidden") (name "cx") (value "010927490648632664335:4yu6uuqr9ia"))) ;; The Google "Search Documentation" field and button
(input ((type "text") (name "q") (size "16") (style "font-size: 75%;"))) (form ([id "searchbox_010927490648632664335:4yu6uuqr9ia"]
(input ((type "hidden") (name "hq") (value "more:plt"))) [action "http://www.plt-scheme.org/search/"]
(input ((type "hidden") (name "cxq") (value "more:docs"))) [style "display: inline; margin: 0;"])
(input ((type "submit") (name "sa") (value "Search Documentation") (input ([type "hidden"] [name "cx"]
(style "font-size: 75%;"))) [value "010927490648632664335:4yu6uuqr9ia"]))
(input ((type "hidden") (name "cof") (value "FORID:9"))))) (input ([type "text"] [name "q"] [style "font-size: 75%;"]
nbsp)))])) [size "16"]))
(input ([type "hidden"] [name "hq"] [value "more:plt"]))
(input ([type "hidden"] [name "cxq"] [value "more:docs"]))
; the internal browser makes a "split" screen by having the left items at the top, (input ([type "submit"] [name "sa"] [style "font-size: 75%;"]
; and the right items at the bottom [value "Search Documentation"]))
(input ([type "hidden"] [name "cof"] [value "FORID:9"]))))
nbsp))
)]))
;; the internal browser makes a "split" screen by having the left
;; items at the top, and the right items at the bottom
(define (make-split-page/internal-browser title top-items left-items right-header right-items) (define (make-split-page/internal-browser title top-items left-items right-header right-items)
(html-page (html-page
#:title title #:title title
#:body `(div ,(html-left-items (append #;left-header-items #:body `(div ,(html-left-items (append ;; left-header-items
left-items left-footer-items)) left-items
left-footer-items))
(hr) (hr)
,@(html-right-items right-items)))) ,@(html-right-items right-items))))
; simple version that only shows the contents and no menu ;; simple version that only shows the contents and no menu
(define (make-simple-page/internal-browser title top-items left-items right-header right-items) (define (make-simple-page/internal-browser
(html-page title top-items left-items right-header right-items)
(html-page
#:title title #:title title
#:body (if (equal? left-items "home") #:body (if (equal? left-items "home")
`(div (h1 "PLT Help Desk") ,(html-left-items right-items)) `(div (h1 "PLT Help Desk") ,(html-left-items right-items))
`(div (h1 ,right-header) `(div (h1 ,right-header)
,@(html-right-items right-items))))) ,@(html-right-items right-items)))))
; an external is capable of displaying a proper split screen ;; an external is capable of displaying a proper split screen
(define (make-split-page title top-items left-items right-header right-items) (define (make-split-page title top-items left-items right-header right-items)
(html-page (html-page
#:title title #:title title
#:bodies `(,@top-items ,(make-split-screen left-items right-header right-items)))) #:bodies `(,@top-items ,(make-split-screen left-items
right-header
right-items))))
(define (make-split-screen left-items right-header right-items) (define (make-split-screen left-items right-header right-items)
`(table ((height "80%") (width "100%") (align "center") (border "0") (cellspacing "0") (cellpadding "30")) `(table ([height "80%"] [width "100%"] [align "center"] [border "0"]
(tr ((valign "top")) [cellspacing "0"] [cellpadding "30"])
(td ((height "80%") (width "50%") (align "center") (valign "top") (bgcolor "#74ca56")) (tr ([valign "top"])
; LEFT TABLE (td ([height "80%"] [width "50%"] [align "center"] [valign "top"]
(table ((align "center") (class "sansa") (border "0") (cellpadding "0") (cellspacing "4")) [bgcolor "#74ca56"])
#;(tr (td ((align "center")) ;; LEFT TABLE
(img ((src "http://www.plt-scheme.org/plt-green.jpg") (table ([align "center"] [class "sansa"] [border "0"]
(width "133") (height "128") (alt "[icon]"))))) [cellpadding "0"] [cellspacing "4"])
,(html-left-items (append left-header-items left-items left-footer-items))) ;; (tr (td ([align "center"])
(td ((height "100%") (width "50%") (align "left") (valign "top")) ;; (img ([src "http://www.plt-scheme.org/plt-green.jpg"]
; RIGHT TABLE ;; [width "133"] [height "128"] [alt "[icon]"]))))
(table ((width "80%") (class "sansa") (align "center") (border "0") ,(html-left-items
(cellpadding "0") (cellspacing "0")) (append left-header-items left-items left-footer-items))))
(tr (td (h1 ,right-header))) (td ([height "100%"] [width "50%"] [align "left"] [valign "top"])
;(tr (td (small (small nbsp)))) ;; RIGHT TABLE
(tr (td (table ((border "0") (cellpadding "3") (cellspacing "0") (width "100%")) (table ([width "80%"] [class "sansa"] [align "center"]
,@(html-right-items right-items)))))))))) [border "0"] [cellpadding "0"] [cellspacing "0"])
(tr (td (h1 ,right-header)))
;; (tr (td (small (small nbsp))))
(tr (td (table ([border "0"] [width "100%"]
[cellpadding "3"] [cellspacing "0"])
,@(html-right-items right-items)))))))))
;;; ;;;
;;; ITEM FORMATTING ;;; ITEM FORMATTING
;;; (ad hoc markup inherited) ;;; (ad hoc markup inherited)
(define (html-left-items items) (define (html-left-items items)
`(tr (td (table ,@(mappend html-left-item items))))) `(tr (td (table ,@(mappend html-left-item items)))))
(define (html-left-item item) (define (html-left-item item)
(match item (match item
['UP (list '(font ((size "-2")) nbsp))] ['UP (list '(font ((size "-2")) nbsp))]
['-- (list '(tr ((height "4")) (td ((colspan "2")))))] ['-- (list '(tr ((height "4")) (td ((colspan "2")))))]
[('VERBATIM sxml) (list `(tr (td ((align "center")) ,sxml)))] [('VERBATIM sxml) (list `(tr (td ((align "center")) ,sxml)))]
[(header) (list `(tr (td #;((colspan "2")) ,header)))] [(header) (list `(tr (td #;((colspan "2")) ,header)))]
[(header body ...) (list `(tr (td #;((colspan "2")) ,header)) [(header body ...) (list `(tr (td #;((colspan "2")) ,header))
`(tr (td ,@body)))] `(tr (td ,@body)))]
[other (list other)])) [other (list other)]))
(define (html-right-items items) (define (html-right-items items)
(mappend html-right-item items)) (mappend html-right-item items))
(define (html-right-item item) (define (html-right-item item)
(match item (match item
['-- (list '(tr ((height "4")) (td ((colspan "2")))))] ['-- (list '(tr ((height "4")) (td ((colspan "2")))))]
[('VERBATIM item) item] [('VERBATIM item) item]
[(body ...) (list body)])) [(body ...) (list body)]))
(provide make-split-screen (provide make-split-screen
make-split-page make-split-page
make-split-page/internal-browser make-split-page/internal-browser
make-simple-page/internal-browser) make-simple-page/internal-browser)
) )

28
collects/help/servlets/private/url.ss
View File

@ -1,31 +1,31 @@
(module url mzscheme (module url mzscheme
(require "../../private/internal-hp.ss") (require "../../private/internal-hp.ss")
(provide (all-defined)) (provide (all-defined))
(define url-helpdesk-root (define url-helpdesk-root
(format "http://~a:~a/servlets/" internal-host (internal-port))) (format "http://~a:~a/servlets/" internal-host (internal-port)))
(define url-helpdesk-home (string-append url-helpdesk-root "home.ss")) (define url-helpdesk-home (string-append url-helpdesk-root "home.ss"))
(define url-helpdesk-results (string-append url-helpdesk-root "results.ss")) (define url-helpdesk-results (string-append url-helpdesk-root "results.ss"))
(define (url-home-subpage subpage-str) (define (url-home-subpage subpage-str)
(string-append url-helpdesk-home "?subpage=" subpage-str)) (string-append url-helpdesk-home "?subpage=" subpage-str))
(define (version-major) (define (version-major)
; TODO: Fix this ; TODO: Fix this
(cond [(regexp-match #px"^(\\d+).*$" (version)) (cond [(regexp-match #px"^(\\d+).*$" (version))
=> cadr] => cadr]
[else "352"])) [else "352"]))
(define (url-manual-on-doc-server manual) (define (url-manual-on-doc-server manual)
(string-append (format "http://download.plt-scheme.org/doc/~a/html/~a/"
"http://download.plt-scheme.org/doc/" (version-major) manual))
(version-major) "/html/" manual "/"))
(define (url-static doc manual path) (define (url-static doc manual path)
(string-append url-helpdesk-root "static.ss/" doc "/" manual "/" path)) (format "~astatic.ss/~a/~a/"
url-helpdesk-root doc manual path))
(define url-external-announcement-list-archive "http://list.cs.brown.edu/pipermail/plt-announce/") (define url-external-announcement-list-archive "http://list.cs.brown.edu/pipermail/plt-announce/")
(define url-external-discussion-list-archive "http://list.cs.brown.edu/pipermail/plt-scheme/") (define url-external-discussion-list-archive "http://list.cs.brown.edu/pipermail/plt-scheme/")
(define url-external-discussion-list-archive-old "http://www.cs.utah.edu/plt/mailarch/") (define url-external-discussion-list-archive-old "http://www.cs.utah.edu/plt/mailarch/")
@ -33,11 +33,11 @@
(define url-external-send-bug-report "http://bugs.plt-scheme.org/") (define url-external-send-bug-report "http://bugs.plt-scheme.org/")
(define url-external-tour-of-drscheme "http://www.plt-scheme.org/software/drscheme/tour/") (define url-external-tour-of-drscheme "http://www.plt-scheme.org/software/drscheme/tour/")
(define url-external-planet "http://planet.plt-scheme.org/") (define url-external-planet "http://planet.plt-scheme.org/")
(define url-helpdesk-acknowledge (url-home-subpage "acknowledge")) (define url-helpdesk-acknowledge (url-home-subpage "acknowledge"))
(define url-helpdesk-books (url-home-subpage "books")) (define url-helpdesk-books (url-home-subpage "books"))
(define url-helpdesk-documentation (url-home-subpage "documentation")) (define url-helpdesk-documentation (url-home-subpage "documentation"))
(define url-helpdesk-drscheme (url-home-subpage "drscheme")) (define url-helpdesk-drscheme (url-home-subpage "drscheme"))
(define url-helpdesk-drscheme-faq (url-static "doc1" "drscheme" "drscheme-Z-H-5.html#node_chap_5")) (define url-helpdesk-drscheme-faq (url-static "doc1" "drscheme" "drscheme-Z-H-5.html#node_chap_5"))
(define url-helpdesk-drscheme-manual (url-static "doc1" "drscheme" "index.htm")) (define url-helpdesk-drscheme-manual (url-static "doc1" "drscheme" "index.htm"))
(define url-helpdesk-faq (url-home-subpage "faq")) (define url-helpdesk-faq (url-home-subpage "faq"))

16
collects/help/servlets/releaseinfo.ss
View File

@ -1,7 +1,8 @@
(module releaseinfo mzscheme (module releaseinfo mzscheme
(require "private/util.ss" (require "private/util.ss"
"private/headelts.ss" "private/headelts.ss"
(lib "servlet.ss" "web-server")) (lib "servlet.ss" "web-server")
(lib "dirs.ss" "setup"))
(define (link-stuff url txt) (define (link-stuff url txt)
`(li (b (a ([href ,url]) ,txt)))) `(li (b (a ([href ,url]) ,txt))))
@ -17,18 +18,13 @@
(head ,hd-css ,@hd-links (title "Release Information")) (head ,hd-css ,@hd-links (title "Release Information"))
(body (body
(h1 "Release Information") (h1 "Release Information")
(p) (p (i "Version: " ,(plt-version)))
(i "Version: " ,(plt-version)) (br)
(p)
(ul ,(link-stuff "/servlets/release/license.ss" "License") (ul ,(link-stuff "/servlets/release/license.ss" "License")
,(link-stuff "/servlets/release/notes.ss" "Release Notes") ,(link-stuff "/servlets/release/notes.ss" "Release Notes")
,(link-stuff "/servlets/release/bugs.ss" "Known Bugs") ,(link-stuff "/servlets/release/bugs.ss" "Known Bugs")
(li (a ([mzscheme "((dynamic-require '(lib |bug-report.ss| |help|) 'help-desk:report-bug))"]) (li (a ([mzscheme "((dynamic-require '(lib |bug-report.ss| |help|) 'help-desk:report-bug))"])
(b "Submit a bug report"))) (b "Submit a bug report")))
,(link-stuff "/servlets/release/patches.ss" "Downloadable Patches")) ,(link-stuff "/servlets/release/patches.ss" "Downloadable Patches"))
(p) (p "The PLT software is installed on this machine at" (br)
"The PLT software is installed on this machine at" (br) (pre nbsp nbsp ,(path->string (find-collects-dir))))))))))
(pre nbsp nbsp
,(let-values ([(base file dir?)
(split-path (collection-path "mzlib"))])
(path->string base)))))))))

27
collects/help/servlets/resources.ss
View File

@ -10,15 +10,13 @@
(lambda () (lambda ()
(html-page (html-page
#:title "External Resources" #:title "External Resources"
#:bodies #:bodies
`((h1 "External Resources") `((h1 "External Resources")
(p) (p "DrScheme is created by "
"DrScheme is created by " (a ([href "http://www.plt-scheme.org/"] [target "_top"]) "PLT")
(a ([href "http://www.plt-scheme.org/"] [target "_top"]) "PLT") " based at Northeastern University, the University of Utah,"
" based at Northeastern University, the University of Utah," " Brown University, and the University of Chicago."
" Brown University, and the University of Chicago." " Here are some links related to our activities.")
" Here are some links related to our activities."
(p)
(ul (li (b (a ([href "resources/teachscheme.ss"]) (ul (li (b (a ([href "resources/teachscheme.ss"])
"TeachScheme! Workshops")) "TeachScheme! Workshops"))
": Free summer program") ": Free summer program")
@ -26,10 +24,9 @@
": From PLT and contributors") ": From PLT and contributors")
(li (b (a ([href "resources/maillist.ss"]) "Mailing Lists")) (li (b (a ([href "resources/maillist.ss"]) "Mailing Lists"))
": How to subscribe")) ": How to subscribe"))
(p) (p "Also, the Schemers.org Web site provides links for "
"Also, the Schemers.org Web site provides links for " "many Scheme resources, including books, implementations, "
"many Scheme resources, including books, implementations, " "and libraries: "
"and libraries: " (a ([href "http://www.schemers.org/"] [target "_top"])
(a ([href "http://www.schemers.org/"] [target "_top"]) "http://www.schemers.org/") ".")))))))
"http://www.schemers.org/") "."))))))

2
collects/help/servlets/scheme/doc.ss
View File

@ -43,4 +43,4 @@
(a ([href "/servlets/howtouse.ss#search"]) "Searching") (a ([href "/servlets/howtouse.ss#search"]) "Searching")
" in Help Desk finds documenation from all sources, including " " in Help Desk finds documenation from all sources, including "
(a ([href "/servlets/howtodrscheme.ss"]) "DrScheme") (a ([href "/servlets/howtodrscheme.ss"]) "DrScheme")
" and the language and library documentation.")))))) " and the language and library documentation."))))))

2
collects/help/servlets/scheme/langlevels.ss
View File

@ -59,4 +59,4 @@
"Please follow the links on this page for more information. If you" "Please follow the links on this page for more information. If you"
" have additional questions or comments, please contact us at " " have additional questions or comments, please contact us at "
(a ((href "mailto:scheme@plt-scheme.org")) "scheme@plt-scheme.org") (a ((href "mailto:scheme@plt-scheme.org")) "scheme@plt-scheme.org")
".")))))) "."))))))

2
collects/help/servlets/scheme/misc.ss
View File

@ -35,4 +35,4 @@
(a ((href "/servlets/howtouse.ss#search")) "searching") (a ((href "/servlets/howtouse.ss#search")) "searching")
" in Help Desk. Also, check " " in Help Desk. Also, check "
(a ((href "http://www.htus.org/")) (i "How to Use Scheme")) (a ((href "http://www.htus.org/")) (i "How to Use Scheme"))
".")))))) "."))))))

27
collects/help/servlets/scheme/misc/activex.ss
View File

@ -11,20 +11,21 @@
(with-errors-to-browser (with-errors-to-browser
send/finish send/finish
(lambda () (lambda ()
`(HTML `(html
(HEAD ,hd-css (head ,hd-css
,@hd-links ,@hd-links
(TITLE "How to use ActiveX components")) (title "How to use ActiveX components"))
(BODY (body
(H1 "How to use ActiveX components") (h1 "How to use ActiveX components")
(A ((NAME "com") (VALUE "COM"))) (a ([name "com"] [value "COM"]))
(A ((NAME "activex") (VALUE "ActiveX"))) (a ([name "activex"] [value "ActiveX"]))
"If you run Windows, you can use MysterX, a library for " "If you run Windows, you can use MysterX, a library for "
"controlling COM and ActiveX components within DrScheme, " "controlling COM and ActiveX components within DrScheme, "
"MzScheme, or MrEd. MysterX is available from " "MzScheme, or MrEd. MysterX is available from "
(PRE (pre
'nbsp 'nbsp (A ((HREF "http://www.plt-scheme.org/software/mysterx/") nbsp nbsp
(TARGET "_top")) "http://www.plt-scheme.org/software/mysterx/")) (a ((href "http://www.plt-scheme.org/software/mysterx/")
(P) (target "_top"))
,(collection-doc-link "mysterx" "http://www.plt-scheme.org/software/mysterx/"))
"The MysterX collection"))))))) (p)
,(collection-doc-link "mysterx" "The MysterX collection")))))))

46
collects/help/servlets/scheme/misc/batch.ss
View File

@ -1,47 +1,47 @@
(module batch mzscheme (module batch mzscheme
(require "../../private/headelts.ss" (require "../../private/headelts.ss"
"../../private/util.ss") "../../private/util.ss")
(require (lib "servlet.ss" "web-server")) (require (lib "servlet.ss" "web-server"))
(provide interface-version timeout start) (provide interface-version timeout start)
(define interface-version 'v1) (define interface-version 'v1)
(define timeout +inf.0) (define timeout +inf.0)
(define (start initial-request) (define (start initial-request)
(with-errors-to-browser (with-errors-to-browser
send/finish send/finish
(lambda () (lambda ()
`(HTML `(html
(HEAD ,hd-css (head ,hd-css
,@hd-links ,@hd-links
(TITLE "How to write Windows batch files")) (title "How to write Windows batch files"))
(BODY (body
(H1 "How to write Windows batch files") (h1 "How to write Windows batch files")
(A ((NAME "sh") (VALUE "Batch files"))) (a ((name "sh") (value "Batch files")))
(A ((NAME "sh2") (VALUE ".bat files"))) (a ((name "sh2") (value ".bat files")))
"You can put MzScheme code in a Windows batch file, that is, a " "You can put MzScheme code in a Windows batch file, that is, a "
"file with a .BAT extension. Batch files can be executed " "file with a .BAT extension. Batch files can be executed "
"directly from the command line. In Windows 95, 98, and Me, " "directly from the command line. In Windows 95, 98, and Me, "
"the batch file looks like:" "the batch file looks like:"
(PRE (pre
" ; @echo off" (BR) " ; @echo off" (br)
" ; d:\\plt\\mzscheme -r %0 %1 %2 %3 %4 %5 %6 %7 %8 %9" (BR) " ; d:\\plt\\mzscheme -r %0 %1 %2 %3 %4 %5 %6 %7 %8 %9" (br)
" ; goto :end" (BR) " ; goto :end" (br)
" ... " (I "scheme-program") " ..." (BR) " ... " (i "scheme-program") " ..." (br)
" ; :end") " ; :end")
"With this code, your batch file can use as many as nine " "With this code, your batch file can use as many as nine "
"parameters." "parameters."
(P) (p)
"In Windows NT, Windows 2000, and Windows XP, you can instead write " "In Windows NT, Windows 2000, and Windows XP, you can instead write "
(PRE (pre
" ; @echo off" (BR) " ; @echo off" (br)
" ; d:\\plt\\mzscheme -r %0 %*" (BR) " ; d:\\plt\\mzscheme -r %0 %*" (br)
" ; goto :end" (BR) " ; goto :end" (br)
" ... " (I "scheme-program") " ..." (BR) " ... " (i "scheme-program") " ..." (br)
" ; :end") " ; :end")
"This code allows an arbitrary number of parameters to your " "This code allows an arbitrary number of parameters to your "
"batch file." "batch file."
(P) (p)
"The batch file code works by combining both batch and MzScheme " "The batch file code works by combining both batch and MzScheme "
"syntax in a single file. When invoked from the command line, " "syntax in a single file. When invoked from the command line, "
"the semicolons are ignored. The second line invokes MzScheme " "the semicolons are ignored. The second line invokes MzScheme "
@ -49,4 +49,4 @@
"lines beginning with semicolons as comments, and runs the " "lines beginning with semicolons as comments, and runs the "
"Scheme code. When the Scheme program is " "Scheme code. When the Scheme program is "
"done, control returns to the batch file, and the " "done, control returns to the batch file, and the "
(TT "goto") " jumps around the Scheme code.")))))) (tt "goto") " jumps around the Scheme code."))))))

260
collects/help/servlets/scheme/misc/cgi.ss
View File

@ -1,153 +1,151 @@
(module cgi mzscheme (module cgi mzscheme
(require "../../private/headelts.ss") (require "../../private/headelts.ss")
(require (lib "servlet.ss" "web-server")) (require (lib "servlet.ss" "web-server"))
(provide interface-version timeout start) (provide interface-version timeout start)
(define interface-version 'v1) (define interface-version 'v1)
(define timeout +inf.0) (define timeout +inf.0)
(define (start initial-request) (define (start initial-request)
(with-errors-to-browser (with-errors-to-browser
send/finish send/finish
(lambda () (lambda ()
`(HTML `(html
(HEAD ,hd-css (head ,hd-css
,@hd-links ,@hd-links
(TITLE "How to write CGI scripts")) (title "How to write CGI scripts"))
(BODY (body
(H1 "How to write CGI scripts") (h1 "How to write CGI scripts")
(A ((NAME "cgi") (VALUE "CGI scripts"))) (a ([name "cgi"] (value "CGI scripts")))
"Type " (TT "CGI") " in the " (B "Search for") " " "Type " (tt "CGI") " in the " (b "Search for") " "
"field in Help Desk and click on the " "field in Help Desk and click on the "
(B (TT "Search")) " button to get information " (b (tt "Search")) " button to get information "
"on CGI-related functions." "on CGI-related functions."
(P) (p)
"A CGI script is merely a program with funny inputs and " "A CGI script is merely a program with funny inputs and "
"outputs. Input comes either from an environment variable " "outputs. Input comes either from an environment variable "
"or through the standard input port, in a special format. " "or through the standard input port, in a special format. "
"Output consists of a MIME header followed by the content. " "Output consists of a MIME header followed by the content. "
"Everything in-between is pure program." "Everything in-between is pure program."
(P) (p)
"MzScheme comes with a CGI library that is designed to " "MzScheme comes with a CGI library that is designed to "
"make it easy to write such scripts. In the mini-tutorial " "make it easy to write such scripts. In the mini-tutorial "
"below, we'll walk you through the " "below, we'll walk you through the "
"construction of such a script. If you have questions or " "construction of such a script. If you have questions or "
"comments, send email to " "comments, send email to "
(A ((HREF "mailto:sk@plt-scheme.org")) (a ((href "mailto:sk@plt-scheme.org")) "sk@plt-scheme.org") "."
"sk@plt-scheme.org") "." (p)
(P) (hr)
(HR) (p)
(P) "Let's write a simple \"finger server\" in MzScheme. "
"Let's write a simple \"finger server\" in MzScheme. " "The front-end will be a Web form that accepts a username. "
"The front-end will be a Web form that accepts a username. " "The form should supply a username in the field `name'. "
"The form should supply a username in the field `name'. " "The CGI script fingers that user."
"The CGI script fingers that user." (p)
(P) "First, make sure you have MzScheme installed on the host "
"First, make sure you have MzScheme installed on the host " "where your Web server is located."
"where your Web server is located." (p)
(P) "A CGI script must be an executable. Each OS has different "
"A CGI script must be an executable. Each OS has different " "ways of launching an application. Under Unix, it's "
"ways of launching an application. Under Unix, it's " "probably easiest to make them simple shell scripts. "
"probably easiest to make them simple shell scripts. " "Therefore, place the following magic incantation at the "
"Therefore, place the following magic incantation at the " "top of your script:"
"top of your script:" (p)
(P) (pre " #!/bin/sh" (br)
(PRE " string=? ; exec /usr/local/bin/mzscheme -r $0 \"$@\"")
" #!/bin/sh" (BR) (p)
" string=? ; exec /usr/local/bin/mzscheme -r $0 \"$@\"") "Make sure the path to MzScheme is specified correctly."
(P) (p)
"Make sure the path to MzScheme is specified correctly." "Now we're in Scheme-land. First, let's load the Scheme "
(P) "CGI library and define where `finger' resides."
"Now we're in Scheme-land. First, let's load the Scheme " (p)
"CGI library and define where `finger' resides." (pre
(P) " (require (lib \"cgi.ss\" \"net\"))" (br)
(PRE " (define finger-program \"/usr/bin/finger\")")
" (require (lib \"cgi.ss\" \"net\"))" (BR) (p)
" (define finger-program \"/usr/bin/finger\")") "Next we must get the names bound by the form, and "
(P) "extract the username field."
"Next we must get the names bound by the form, and " (p)
"extract the username field." (pre
(P) " (let ((bindings (get-bindings)))" (br)
(PRE " (let ((name (extract-binding/single 'name bindings)))")
" (let ((bindings (get-bindings)))" (BR) (p)
" (let ((name (extract-binding/single 'name bindings)))") "We use extract-binding/single to make sure only one name "
(P) "field was bound. (You can bind the same field multiple "
"We use extract-binding/single to make sure only one name " "times using check-boxes. This is just one kind of "
"field was bound. (You can bind the same field multiple " "error-checking; a robust CGI script will do more."
"times using check-boxes. This is just one kind of " (p)
"error-checking; a robust CGI script will do more." "Next we invoke the finger program using `process*'. "
(P) "If no username was specified, we just run finger on the host."
"Next we invoke the finger program using `process*'. " (p)
"If no username was specified, we just run finger on the host." (pre
(P) " (let ((results (if (string=? name \"\"))" (br)
(PRE " (process* finger-program)" (br)
" (let ((results (if (string=? name \"\"))" (BR) " (process* finger-program name))))")
" (process* finger-program)" (BR) (p)
" (process* finger-program name))))") "The `process*' function returns a list of several values. "
(P) "The first of these is the output port. Let's pull this "
"The `process*' function returns a list of several values. " "out and name it."
"The first of these is the output port. Let's pull this " (p)
"out and name it." (pre
(P) " (let ((proc->self (car results)))")
(PRE (p)
" (let ((proc->self (car results)))") "Now we extract the output of running finger into a "
(P) "list of strings."
"Now we extract the output of running finger into a " (p)
"list of strings." (pre
(P) " (let ((strings (let loop " (br)
(PRE " (let ((l (read-line proc->self)))" (br)
" (let ((strings (let loop " (BR) " (if (eof-object? l)" (br)
" (let ((l (read-line proc->self)))" (BR) " null" (br)
" (if (eof-object? l)" (BR) " (cons l (loop))))))))")
" null" (BR) (p)
" (cons l (loop))))))))") "All that's left is to print this out to the user. "
(P) "We use the `generate-html-output' procedure to do that, "
"All that's left is to print this out to the user. " "which takes care of generating the appropriate MIME header "
"We use the `generate-html-output' procedure to do that, " "(as required of CGI scripts). "
"which takes care of generating the appropriate MIME header " "Note that the <pre> tag of HTML doesn't prevent its "
"(as required of CGI scripts). " "contents from being processed. To avoid this "
"Note that the <PRE> tag of HTML doesn't prevent its " "(i.e., to generate truly verbatim output), "
"contents from being processed. To avoid this " "we use `string->html', which knows about HTML quoting "
"(i.e., to generate truly verbatim output), " "conventions."
"we use `string->html', which knows about HTML quoting " (p)
"conventions." (pre
(P) " (generate-html-output \"Finger Gateway Output\"" (br)
(PRE " (append " (br)
" (generate-html-output \"Finger Gateway Output\"" (BR) " '(\"<pre>\")" (br)
" (append " (BR) " (map string->html strings)" (br)
" '(\"<PRE>\")" (BR) " '(\"</pre>\"))))))))")
" (map string->html strings)" (BR) (p)
" '(\"</PRE>\"))))))))") "That's all! This program will work irrespective of "
(P) "whether the form uses a GET or POST method to send its "
"That's all! This program will work irrespective of " "data over, which gives designers additional flexibility "
"whether the form uses a GET or POST method to send its " "(GET provides a weak form of persistence, while "
"data over, which gives designers additional flexibility " "POST is more robust and better suited to large volumes of "
"(GET provides a weak form of persistence, while " "data)."
"POST is more robust and better suited to large volumes of " (p)
"data)." "Here's the entire program, once again:"
(P) (p)
"Here's the entire program, once again:" (pre
(P) " #!/bin/sh" (br)
(PRE " string=? ; exec /usr/local/bin/mzscheme -r $0 \"$@\"" (br)
" #!/bin/sh" (BR) "" (br)
" string=? ; exec /usr/local/bin/mzscheme -r $0 "$@"" (BR) " (require (lib \"cgi.ss\" \"net\"))" (br)
"" (BR) " (define finger-program \"/usr/bin/finger\")" (br)
" (require (lib \"cgi.ss\" \"net\"))" (BR) "" (br)
" (define finger-program \"/usr/bin/finger\")" (BR) " (let ((bindings (get-bindings)))" (br)
"" (BR) " (let ((name (extract-binding/single 'name bindings)))" (br)
" (let ((bindings (get-bindings)))" (BR) " (let ((results (if (string=? name "")" (br)
" (let ((name (extract-binding/single 'name bindings)))" (BR) " (process* finger-program)" (br)
" (let ((results (if (string=? name "")" (BR) " (process* finger-program name))))" (br)
" (process* finger-program)" (BR) " (let ((proc->self (car results)))" (br)
" (process* finger-program name))))" (BR) " (let ((strings (let loop " (br)
" (let ((proc->self (car results)))" (BR) " (let ((l (read-line proc->self)))" (br)
" (let ((strings (let loop " (BR) " (if (eof-object? l)" (br)
" (let ((l (read-line proc->self)))" (BR) " null" (br)
" (if (eof-object? l)" (BR) " (cons l (loop)))))))" (br)
" null" (BR) " (generate-html-output \"Finger Gateway Output\"" (br)
" (cons l (loop)))))))" (BR) " (append" (br)
" (generate-html-output \"Finger Gateway Output\"" (BR) " '(\"<pre>\")" (br)
" (append" (BR) " (map string->html strings)" (br)
" '(\"<PRE>\")" (BR) " '(\"</pre>\"))))))))")))))))
" (map string->html strings)" (BR)
" '(\"</PRE>\"))))))))")))))))

32
collects/help/servlets/scheme/misc/database.ss
View File

@ -11,25 +11,27 @@
(with-errors-to-browser (with-errors-to-browser
send/finish send/finish
(lambda () (lambda ()
`(HTML `(html
(HEAD ,hd-css (head ,hd-css
,@hd-links ,@hd-links
(TITLE "How to connect to databases")) (title "How to connect to databases"))
(BODY (body
(H1 "How to connect to databases") (h1 "How to connect to databases")
(A ((NAME "db") (VALUE "Database connections"))) (a ([name "db"] [value "Database connections"]))
"SrPersist (\"Sister Persist\") is an ODBC interface for " "SrPersist (\"Sister Persist\") is an ODBC interface for "
"DrScheme and MzScheme. " "DrScheme and MzScheme. "
"Download SrPersist from " "Download SrPersist from "
(PRE (pre
" " " "
(A ((HREF "http://www.plt-scheme.org/software/srpersist/") (a ([href "http://www.plt-scheme.org/software/srpersist/"]
(TARGET "_top")) "http://www.plt-scheme.org/software/srpersist/") ". ") [target "_top"])
"http://www.plt-scheme.org/software/srpersist/") ". ")
"ODBC is a very low-level interface. " "ODBC is a very low-level interface. "
"Francisco Solsona has built a higher-level interface, " "Francisco Solsona has built a higher-level interface, "
"SchemeQL, that uses SrPersist. See " "SchemeQL, that uses SrPersist. See "
(PRE (pre
" " " "
(A ((HREF "http://schematics.sourceforge.net/schemeql.html") (a ((href "http://schematics.sourceforge.net/schemeql.html")
(TARGET "_top")) "http://schematics.sourceforge.net/schemeql.html")) (target "_top"))
" for more details.")))))) "http://schematics.sourceforge.net/schemeql.html"))
" for more details."))))))

24
collects/help/servlets/scheme/misc/graphics.ss
View File

@ -12,24 +12,24 @@
(with-errors-to-browser (with-errors-to-browser
send/finish send/finish
(lambda () (lambda ()
`(HTML `(html
(HEAD ,hd-css (head ,hd-css
,@hd-links ,@hd-links
(TITLE "How to write graphics programs")) (title "How to write graphics programs"))
(BODY (body
(H1 "How to write graphics programs") (h1 "How to write graphics programs")
(A ((NAME "gfx") (VALUE "Graphics"))) (a ([name "gfx"] [value "Graphics"]))
(A ((NAME "gui") (VALUE "GUIs"))) (a ([name "gui"] [value "GUIs"]))
(A ((NAME "gui2") (VALUE "Graphical User Interfaces"))) (a ([name "gui2"] [value "Graphical User Interfaces"]))
"To write graphics programs, use DrScheme with the " "To write graphics programs, use DrScheme with the "
"Graphical (MrEd) flavor of the PLT " "Graphical (MrEd) flavor of the PLT "
(A ((HREF "/servlets/scheme/what.ss")) " language") ". " (a ([href "/servlets/scheme/what.ss"]) " language") ". "
"MrEd provides a complete GUI toolbox that is described " "MrEd provides a complete GUI toolbox that is described "
"in " "in "
,(main-manual-page "mred") ". " ,(main-manual-page "mred") ". "
(P) (p)
"For simple graphics programs, you may also use the " "For simple graphics programs, you may also use the "
"viewport-based graphics library, which is described in " "viewport-based graphics library, which is described in "
,(manual-entry "misclib" "viewport" "Viewport Graphics") ". " ,(manual-entry "misclib" "viewport" "Viewport Graphics") ". "
"The following declaration loads viewport graphics into MrEd:" "The following declaration loads viewport graphics into MrEd:"
(PRE " (require (lib \"graphics.ss\" \"graphics\"))"))))))) (pre " (require (lib \"graphics.ss\" \"graphics\"))")))))))

2
collects/help/servlets/scheme/what.ss
View File

@ -102,4 +102,4 @@
(a ([name "lang-sel"] [value "language, setting"])) (a ([name "lang-sel"] [value "language, setting"]))
"To change the" "To change the"
" language, select the " (b "Choose Language...") " item in the " " language, select the " (b "Choose Language...") " item in the "
(B "Language") " menu.")))))) (B "Language") " menu."))))))

6
collects/help/servlets/static.ss
View File

@ -1,6 +1,6 @@
; Serve static documentation. ;; Serve static documentation.
; A search bar is added on top of the screen, when an external browser is used. ;; A search bar is added on top of the screen, when an external browser is used.
; (which is why we don't let the web-server serve the documentation directly) ;; (which is why we don't let the web-server serve the documentation directly)
(module static mzscheme (module static mzscheme
(require (lib "private/mime-types.ss" "web-server") (require (lib "private/mime-types.ss" "web-server")

2
collects/help/servlets/teachpacks.ss
View File

@ -16,4 +16,4 @@
(ul (li (b (a ([href ,(get-manual-index "teachpack")]) (ul (li (b (a ([href ,(get-manual-index "teachpack")])
"Teachpacks for \"How to Design Programs\""))) "Teachpacks for \"How to Design Programs\"")))
(li (b (a ([href ,(get-manual-index "teachpack-htdc")]) (li (b (a ([href ,(get-manual-index "teachpack-htdc")])
"Teachpacks for \"How to Design Classes\"")))))))))) "Teachpacks for \"How to Design Classes\""))))))))))