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

major cleanups in the help desk servlets

Browse Source 
svn: r4941
This commit is contained in:
Eli Barzilay 2006-11-23 22:46:57 +00:00
parent 0a857f8d10
commit f68b85da36
38 changed files with 1176 additions and 1545 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/help/servlets/README
View File

@ -1,15 +1,14 @@
When the doc/help subcollection is installed, the installer creates When the doc/help subcollection is installed, the installer creates an
an hdindex file. See plt/collects/help/doc.txt for information about hdindex file. See plt/collects/help/doc.txt for information about the
the structure of such files. structure of such files.
To create index entries for Help Desk servlets, put To create index entries for Help Desk servlets, put anchor entries of
anchor entries of the form the form
(A ((NAME "name") (VALUE "Index entry"))) (a ([name "name"] [value "Index entry"]))
on a single line in the Scheme source. The NAME attribute on a single line in the Scheme source. The `name' attribute can be
can be any string that is unique among such anchors in that any string that is unique among such anchors in that file, though of
file, though of course it should be mnemonic. The VALUE course it should be mnemonic. The `value' attribute is used as the
attribute is used as the index entry that is matched against index entry that is matched against search strings in Help Desk, and
search strings in Help Desk, and appears again as the appears again as the link caption in the Help Desk search results.
link caption in the Help Desk search results.

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

@ -2,19 +2,15 @@
(require (lib "acks.ss" "drscheme") (require (lib "acks.ss" "drscheme")
(lib "servlet.ss" "web-server") (lib "servlet.ss" "web-server")
"private/util.ss") "private/util.ss")
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(HTML `(html (head (title "Acknowledgements"))
(TITLE "Acknowledgements") (body (a ([name "acknowledgements"] [value "acknowledgements"]))
(BODY (h1 "Acknowledgements")
(A ((NAME "acknowledgements") (VALUE "acknowledgements"))) (p)
(H1 "Acknowledgements") ,(get-general-acks)
(P) (p)
,(get-general-acks) ,(get-translating-acks)))))
(P)
,(get-translating-acks)))))

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

@ -1,17 +1,13 @@
(module doc-anchor mzscheme (module doc-anchor mzscheme
(require "private/read-doc.ss") (require "private/read-doc.ss"
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
(let* ([bindings (request-bindings initial-request)] (let* ([bindings (request-bindings initial-request)]
[offset (with-handlers [offset (with-handlers ((void (lambda _ #f)))
((void (lambda _ #f)))
(string->number (string->number
(extract-binding/single 'offset bindings)))]) (extract-binding/single 'offset bindings)))])
(read-doc (extract-binding/single 'file bindings) (read-doc (extract-binding/single 'file bindings)

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

@ -1,25 +1,19 @@
(module doc-content mzscheme (module doc-content mzscheme
(require "private/headelts.ss"
(require "private/headelts.ss") "private/read-lines.ss"
(require "private/read-lines.ss") (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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
(let* ([bindings (request-bindings initial-request)] (let* ([bindings (request-bindings initial-request)]
[file (extract-binding/single 'file bindings)] [file (extract-binding/single 'file bindings)]
[caption (extract-binding/single 'caption bindings)] [caption (extract-binding/single 'caption bindings)]
[offset (with-handlers [offset (with-handlers ((void (lambda _ #f)))
((void (lambda _ #f)))
(string->number (string->number
(extract-binding/single 'offset bindings)))]) (extract-binding/single 'offset bindings)))])
`(HTML `(html (head (title "PLT Help Desk")
(HEAD (TITLE "PLT Help Desk") ,hd-css
,hd-css ,@hd-links)
,@hd-links) ,(read-lines file caption offset)))))
,(read-lines file caption offset)))))

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

@ -1,21 +1,14 @@
(module doc-message mzscheme (module doc-message mzscheme
(require "private/headelts.ss" (require "private/headelts.ss"
"private/util.ss") "private/util.ss"
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
(let ([bindings (request-bindings initial-request)]) (let ([bindings (request-bindings initial-request)])
`(HTML `(html (head ,hd-css ,@hd-links (title "PLT collection message"))
(HEAD ,hd-css (body ,(format-collection-message
,@hd-links (extract-binding/single 'msg bindings))
(TITLE "PLT collection message")) (hr))))))
(BODY
,(format-collection-message
(extract-binding/single 'msg bindings))
(HR))))))

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

@ -30,17 +30,17 @@
(define (item->xexpr item) (define (item->xexpr item)
(cond [(and (pair? item) (symbol? (car item))) item] (cond [(and (pair? item) (symbol? (car item))) item]
[(procedure? item) (item->xexpr (item))] [(procedure? item) (item->xexpr (item))]
[else `(A ([HREF ,(cadr item)]) ,(car item))])) [else `(a ([href ,(cadr item)]) ,(car item))]))
(let ([title (car i)] [subtitle (cadr i)] [url (caddr i)] [subs (cdddr i)]) (let ([title (car i)] [subtitle (cadr i)] [url (caddr i)] [subs (cdddr i)])
`(LI (B (A ([HREF ,url]) ,title)) ": " ,subtitle `(li (b (a ([href ,url]) ,title)) ": " ,subtitle
,@(if (null? subs) ,@(if (null? subs)
'() '()
`((BR) nbsp nbsp nbsp nbsp nbsp nbsp `((br) nbsp nbsp nbsp nbsp nbsp nbsp
(FONT ([SIZE "-2"]) (font ([size "-2"])
,@(apply append ,@(apply append (map (lambda (s) `(,(item->xexpr s) ", "))
(map (lambda (s) `(,(item->xexpr s) ", ")) subs)) subs))
"..."))) "...")))
(BR) (BR)))) (br) (br))))
(define (start initial-request) (define (start initial-request)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
@ -48,14 +48,14 @@
(head (title "PLT Help Desk")) (head (title "PLT Help Desk"))
(body (body
(table ([cellspacing "0"] [cellpadding "0"]) (table ([cellspacing "0"] [cellpadding "0"])
(TR (TD (H1 "PLT Help Desk") (tr (td (h1 "PLT Help Desk")
(UL ,@(map item items)) (ul ,@(map item items))
(P) nbsp nbsp nbsp (p) nbsp nbsp nbsp
(B (A ((HREF "/servlets/acknowledge.ss")) (b (a ((href "/servlets/acknowledge.ss"))
(FONT ([COLOR "forestgreen"]) "Acknowledgements"))) (font ([color "forestgreen"]) "Acknowledgements")))
nbsp nbsp nbsp nbsp nbsp nbsp nbsp nbsp
(B (A ((mzscheme (b (a ([mzscheme
"((dynamic-require '(lib |bug-report.ss| |help|) 'help-desk:report-bug))")) "((dynamic-require '(lib |bug-report.ss| |help|) 'help-desk:report-bug))"])
(FONT ([COLOR "forestgreen"]) "Send a bug report"))) (font ([color "forestgreen"]) "Send a bug report")))
(P) (p)
(I "Version: " ,(plt-version))))))))) (i "Version: " ,(plt-version)))))))))

40
collects/help/servlets/howtodrscheme.ss
View File

@ -1,31 +1,27 @@
(module howtodrscheme mzscheme (module howtodrscheme mzscheme
(require "private/headelts.ss" (require "private/headelts.ss"
"../private/manuals.ss") "../private/manuals.ss"
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "DrScheme"))
(TITLE "DrScheme") (body
(HEAD ,hd-css (h1 "DrScheme")
,@hd-links)
(BODY
(H1 "DrScheme")
"DrScheme is PLT's flagship programming environment. " "DrScheme is PLT's flagship programming environment. "
"See " (A ((HREF "/servlets/scheme/how.ss")) "Software & Components") "See " (a ((href "/servlets/scheme/how.ss")) "Software & Components")
" for a guide to the full suite of PLT tools." " for a guide to the full suite of PLT tools."
(UL (ul (li (b (a ([href ,(get-manual-index "tour")])) "Tour")
(LI (B (A ((HREF ,(get-manual-index "tour")))) "Tour") ": An introduction to DrScheme") ": An introduction to DrScheme")
(LI (B ,(manual-entry "drscheme" (li (b ,(manual-entry "drscheme"
"graphical interface" "graphical interface"
"Interface Essentials")) "Interface Essentials"))
": Quick-start jump into the user manual") ": Quick-start jump into the user manual")
(LI (B (A ((HREF "/servlets/scheme/what.ss")) (li (b (a ([href "/servlets/scheme/what.ss"])
"Languages")) "Languages"))
": Languages supported by DrScheme") ": Languages supported by DrScheme")
(LI (B ,(main-manual-page "drscheme")) ": The complete user manual")))))) (li (b ,(main-manual-page "drscheme"))
": The complete user manual"))))))

50
collects/help/servlets/howtoprogram.ss
View File

@ -3,37 +3,31 @@
"private/headelts.ss" "private/headelts.ss"
"../private/manuals.ss" "../private/manuals.ss"
(lib "servlet.ss" "web-server")) (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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "Program Design"))
(TITLE "Program Design") (body
(HEAD ,hd-css (h1 "Program Design")
,@hd-links) ,(color-highlight `(h2 "For Students"))
(BODY "The textbook " (i "How to Design Programs")
(H1 "Program Design") " provides an introduction to programming using the DrScheme"
,(color-highlight `(H2 "For Students")) " environment. The book is not distributed with DrScheme, but it"
"The textbook " (I "How to Design Programs") " is available online at "
" provides an introduction to programming using the DrScheme environment. " (pre " " (a ([href "http://www.htdp.org/"] [target "_top"])
"The book is not distributed with DrScheme, but it is available online at " "http://www.htdp.org/"))
(PRE (p)
" " (A ((HREF "http://www.htdp.org/") (TARGET "_top"))
"http://www.htdp.org/"))
(P)
"Help Desk provides the following interactive support for the textbook:" "Help Desk provides the following interactive support for the textbook:"
(UL (ul (li (b (a ([href "/servlets/teachpacks.ss"])
(LI (B (A ((HREF "/servlets/teachpacks.ss")) "Teachpack documentation")))) "Teachpack documentation"))))
(P) (p)
,(color-highlight ,(color-highlight `(h2 "For Experienced Programmers"))
`(H2 "For Experienced Programmers")) (ul (li (b (a ((href ,(get-manual-index "t-y-scheme")))
(UL (LI (B (A ((HREF ,(get-manual-index "t-y-scheme"))) "Teach Yourself Scheme in Fixnum Days"))
"Teach Yourself Scheme in Fixnum Days")) ": For programmers with lots of experience in other languages"))
": For programmers with lots of experience in other languages")) ,(color-highlight `(h2 "For Teachers and Researchers"))
,(color-highlight `(H2 "For Teachers and Researchers")) (ul (li (b (a ([href "/servlets/research/why.ss"]) "Why DrScheme?"))
(UL (LI (B (A ((HREF "/servlets/research/why.ss")) "Why DrScheme?")) ": PLT's vision "))))))
": PLT's vision "))))))

61
collects/help/servlets/howtoscheme.ss
View File

@ -1,37 +1,36 @@
(module howtoscheme mzscheme (module howtoscheme mzscheme
(require "../private/manuals.ss") (require "../private/manuals.ss"
"private/headelts.ss"
(require "private/headelts.ss") (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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "Software"))
(TITLE "Software") (body
(HEAD ,hd-css ,@hd-links) (h1 "Software")
(BODY (ul (li (b (a ([href "howtodrscheme.ss"]) "DrScheme"))
(H1 "Software") ": The programming environment")
(UL (li (b (a ([href "/servlets/scheme/what.ss"]) "Languages"))
(LI (B (A ((HREF "howtodrscheme.ss")) "DrScheme")) ": The family of languages supported by PLT Software")
": The programming environment") (li (b (a ([href "/servlets/scheme/how.ss"])
(LI (B (A ((HREF "/servlets/scheme/what.ss")) "Languages")) "Software & Components"))
": The family of languages supported by PLT Software") ": The full suite of PLT tools "
(LI (B (A ((HREF "/servlets/scheme/how.ss")) "Software & Components")) (br) nbsp nbsp nbsp nbsp
": The full suite of PLT tools " (font ([size "-2"])
(BR) nbsp nbsp nbsp nbsp (a ([href "/servlets/scheme/how.ss#installed-components"])
(FONT ((SIZE "-2")) "Installed Components")
(A ((HREF "/servlets/scheme/how.ss#installed-components")) "Installed Components") ", ...")) ", ..."))
(LI (B (A ((href "/servlets/scheme/doc.ss")) "Documentation")) ": Organization and manuals " (li (b (a ([href "/servlets/scheme/doc.ss"]) "Documentation"))
(BR) nbsp nbsp nbsp nbsp ": Organization and manuals "
(FONT ((SIZE "-2")) (br) nbsp nbsp nbsp nbsp
(A ((HREF "/servlets/manuals.ss")) "Manuals") ", ...") ) (font ([size "-2"])
(LI (B (A ((HREF "scheme/misc.ss")) "Hints")) (a ([href "/servlets/manuals.ss"]) "Manuals") ", ...") )
": How to do things in Scheme " ) (li (b (a ([href "scheme/misc.ss"]) "Hints"))
(LI (B ,(manual-entry "drscheme" "frequently asked questions" "FAQ")) ": How to do things in Scheme " )
": Frequently asked questions") (li (b ,(manual-entry "drscheme" "frequently asked questions" "FAQ"))
(LI (B (A ((HREF "releaseinfo.ss")) "Release Information")) ": Frequently asked questions")
": License, notes, and known bugs")))))) (li (b (a ([href "releaseinfo.ss"]) "Release Information"))
": License, notes, and known bugs"))))))

107
collects/help/servlets/howtouse.ss
View File

@ -1,82 +1,71 @@
(module howtouse mzscheme (module howtouse mzscheme
(require "private/util.ss" (require "private/util.ss"
"private/headelts.ss" "private/headelts.ss"
(lib "string-constant.ss" "string-constants")) (lib "string-constant.ss" "string-constants")
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "Help Desk"))
(TITLE "Help Desk") (body
(HEAD ,hd-css (h1 "Help Desk")
,@hd-links) (p)
(BODY (a ([name "helpme"] [value "Help Desk"]))
(H1 "Help Desk")
(P)
(A ((NAME "helpme") (VALUE "Help Desk")))
"Help Desk (the program you're currently running) is a " "Help Desk (the program you're currently running) is a "
"complete source of information about PLT software, " "complete source of information about PLT software, "
"including DrScheme, MzScheme, and MrEd." "including DrScheme, MzScheme, and MrEd."
(P) (p)
"Use Help Desk to find information in either of two ways:" "Use Help Desk to find information in either of two ways:"
(P) (p)
,(color-highlight ,(color-highlight
"1) Navigate the Help Desk information pages by " "1. Navigate the Help Desk information pages by"
"clicking on hyperlinks.") " clicking on hyperlinks.")
(UL (ul
(LI "The " (B ,(string-constant home)) " button " (li "The " (b ,(string-constant home)) " button "
"at the top of the page always takes " "at the top of the page always takes "
"you back to the starting page.") "you back to the starting page.")
(LI "The " (B "Manuals") " link " (li "The " (b "Manuals") " link displays a list"
" displays a list " " of manuals and other documentation.")
" of manuals and other documentation.") (li "The " (b "Send a bug report")
(LI "The " (B "Send a bug report") " link allows you to submit bug reports to PLT."))
" link " (p)
"allows you to submit bug reports to PLT.")) (a ([name "helpsearch"] [value "Searching in Help Desk"]))
(P) (a ([name "search"]))
(A ((NAME "helpsearch") (VALUE "Searching in Help Desk")))
(A ((NAME "search")))
,(color-highlight ,(color-highlight
"2) Search for terms using the " "2. Search for terms using the "
`(B "Find docs for") `(b "Find docs for") " field at the bottom of Help Desk.")
" field at the bottom of Help Desk.") (ul
(UL (li "Enter one or more terms into the " (b "Find docs for") " field.")
(LI "Enter one or more terms into the " (li "Click the " (b "Search") " button "
(B "Find docs for") " field.") "(or hit Enter) to start a search, "
(LI "Click the " (B "Search") " button " "or choose the " (b "Feeling Lucky") " menu item.")
"(or hit Enter) to start a search, " (li "If you click on the " (b "Search") " button, "
"or choose the " (B "Feeling Lucky") " menu item.") "Help Desk scans the documentation pages and "
(LI "If you click on the " (B "Search") " button, " "returns a list of hyperlinks for "
"Help Desk scans the documentation pages and " (i "keyword") ", "
"returns a list of hyperlinks for " (i "index entry") ", and "
(I "keyword") ", " (i "raw text") " matches:"
(I "index entry") ", and " (ul (li (i "Keywords") " are Scheme names, such as " (tt "define")
(I "raw text") " matches:" " and " (tt "cons") ".")
(UL (li (i "Index entries")
(LI (I "Keywords") " are Scheme names, " " are topical phrases, such as \"lists\".")
"such as " (TT "define") " and " (li (i "Raw text") " results are fragments of "
(TT "cons") ".") "text from the documentation pages. "
(LI (I "Index entries") "(Raw text results are useful only as "
" are topical phrases, such as \"lists\".") "a last resort.)")))
(LI (I "Raw text") " results are fragments of " (li "If you perform a lucky search, "
"text from the documentation pages. "
"(Raw text results are useful only as "
"a last resort.)")))
(LI "If you perform a lucky search, "
"Help Desk goes directly to the first item of documentation " "Help Desk goes directly to the first item of documentation "
"that matches the search term, without displaying links to " "that matches the search term, without displaying links to "
"all relevant items.")) "all relevant items."))
(P) (p)
"Help Desk sorts search results according to their source." "Help Desk sorts search results according to their source."
(p) (p)
"If you open Help Desk inside DrScheme, the search results are " "If you open Help Desk inside DrScheme, the search results are "
"filtered based on the language you are using. Use " "filtered based on the language you are using. Use "
(B "Choose Language...") (b "Choose Language...")
" menu item from the " " menu item from the "
(B "Language") (b "Language")
" menu to change the language.")))) " menu to change the language."))))

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

@ -1,8 +1,7 @@
(module manual-section mzscheme (module manual-section mzscheme
(require "../private/manuals.ss" (require "../private/manuals.ss"
"private/headelts.ss") "private/headelts.ss"
(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)
@ -12,23 +11,21 @@
(let* ([bindings (request-bindings initial-request)] (let* ([bindings (request-bindings initial-request)]
[manual (extract-binding/single 'manual bindings)] [manual (extract-binding/single 'manual bindings)]
[raw-section (extract-binding/single 'section bindings)] [raw-section (extract-binding/single 'section bindings)]
; remove quotes ;; remove quotes
[section (substring raw-section [section (substring raw-section
1 (sub1 (string-length raw-section)))] 1 (sub1 (string-length raw-section)))]
[page (with-handlers [page (with-handlers
([void (lambda _ ([void (lambda _
(send/finish (send/finish
`(HTML `(html
(HEAD (TITLE "Can't find manual section") (head ,hd-css ,@hd-links
,hd-css (title "Can't find manual section"))
,@hd-links) (body
(BODY
"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 (send/finish (redirect-to page)))))
(redirect-to page)))))

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

@ -1,13 +1,9 @@
(module manuals mzscheme (module manuals mzscheme
(require "../private/manuals.ss") (require "../private/manuals.ss"
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
(list (list #"text/html" (find-manuals))))
#"text/html"
(find-manuals))))

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

@ -1,51 +1,41 @@
(module missing-manual mzscheme (module missing-manual mzscheme
(require (lib "servlet.ss" "web-server")) (require (lib "servlet.ss" "web-server")
"private/headelts.ss"
(require "private/headelts.ss") "private/util.ss"
(require "private/util.ss"
"../private/standard-urls.ss") "../private/standard-urls.ss")
(define (no-manual manual label link)
(let* ([html-url (make-docs-html-url manual)]
[plt-url (make-docs-plt-url manual)])
`(html
(head ,hd-css
,@hd-links
(TITLE "Missing PLT manual"))
(body ((bgcolor "white"))
,(with-color "red" `(h1 "Documentation missing"))
(P)
"You tried to access documentation for "
,(with-color "blue" `(B ,label)) ". "
"The documentation is not installed on this "
"machine, probably 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)
"After installing, "
(a ((href ,link)) "continue")
" to the originally requested page."
(br) nbsp (br)
(h2 "Read Online")
"Read the documentation on "
(a ((href ,html-url)) "PLT's servers")
"."))))
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
(let ([bindings (request-bindings initial-request)]) (let ([bindings (request-bindings initial-request)])
(no-manual (extract-binding/single 'manual bindings) (no-manual (extract-binding/single 'manual bindings)
(extract-binding/single 'name bindings) (extract-binding/single 'name bindings)
(extract-binding/single 'link bindings))))) (extract-binding/single 'link bindings))))
(define (no-manual manual label link)
(let* ([html-url (make-docs-html-url manual)]
[plt-url (make-docs-plt-url manual)])
`(html
(head ,hd-css ,@hd-links (title "Missing PLT manual"))
(body ([bgcolor "white"])
,(with-color "red" `(h1 "Documentation missing"))
(p)
"You tried to access documentation for "
,(with-color "blue" `(b ,label)) ". "
"The documentation is not installed on this machine, probably"
" 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)
"After installing, "
(a ((href ,link)) "continue")
" to the originally requested page."
(br) nbsp (br)
(h2 "Read Online")
"Read the documentation on "
(a ((href ,html-url)) "PLT's servers")
".")))))

1
collects/help/servlets/private/exit.ss
View File

@ -1,4 +1,3 @@
(module exit mzscheme (module exit mzscheme
(provide exit-box) (provide exit-box)
(define exit-box (box #f))) (define exit-box (box #f)))

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

@ -1,38 +1,14 @@
(module external mzscheme (module external mzscheme
(require (lib "servlet.ss" "web-server") (lib "defmacro.ss") "headelts.ss")
(require (lib "servlet.ss" "web-server") (provide external-box check-external)
(lib "defmacro.ss"))
(require "headelts.ss")
(provide external-box
check-external)
(define external-box (box #f)) (define external-box (box #f))
(define (check-external show url) (define (check-external show url)
(when (unbox external-box) (when (unbox external-box)
(show (show
`(HTML `(html (head ,hd-css ,@hd-links (title "Servlet unavailable"))
(HEAD ,hd-css (body (h3 (font ([color "red"]) "Servlet unavailable"))
,@hd-links (p)
(TITLE "Servlet unavailable")) "Because the PLT Help Desk server is accepting external"
(BODY " connections, the requested Help Desk servlet"
(H3 (blockquote (tt ,url))
(FONT ((COLOR "red")) "is not available."))))))
"Servlet unavailable"))
(P)
"Because the PLT Help Desk server is "
"accepting external connections, the "
"requested Help Desk servlet"
(BLOCKQUOTE (TT ,url))
"is not available."))))))

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

@ -2,56 +2,49 @@
(module headelts mzscheme (module headelts mzscheme
(require (lib "list.ss")) (require (lib "list.ss"))
(provide hd-css hd-links)
(provide hd-css ;; cascading style sheet rules for Help Desk
hd-links)
; cascading style sheet rules for Help Desk ;; (listof (tag attrib+))
;; where attrib is a property name, value pair
; (listof (tag attrib+)) ;; where a value is a symbol or (listof symbol)
; where attrib is a property name, value pair
; where a value is a symbol or (listof symbol)
(define css-rules (define css-rules
'((BODY (background-color white) '([body (background-color white) (font-family (Helvetica sans-serif))]))
(font-family (Helvetica sans-serif)))))
(define nl (string #\newline))
(define (css-rules->style) (define (css-rules->style)
(apply string-append (apply
(map string-append
(lambda (s) (string-append s nl)) (map (lambda (s) (string-append s "\n"))
(map (map (lambda (rule)
(lambda (rule) (let ([tag (car rule)]
(let ([tag (car rule)] [attribs (cdr rule)])
[attribs (cdr rule)]) (string-append
(string-append (symbol->string tag)
(symbol->string tag) " {"
" {" (foldr
(foldr (lambda (s a) (if a (string-append s "; " a) s))
(lambda (s a) #f
(if a (string-append s "; " a) s)) (map
#f (lambda (attrib)
(map (let ([property (car attrib)]
(lambda (attrib) [vals (cadr attrib)])
(let ([property (car attrib)] (string-append
[vals (cadr attrib)]) (symbol->string property) ":"
(string-append (symbol->string property) ":" (if (pair? vals)
(if (pair? vals) (foldr (lambda (s a)
(foldr (lambda (s a) (if a (string-append s "," a) s))
(if a (string-append s "," a) s)) #f
#f (map symbol->string vals))
(map symbol->string vals)) (symbol->string vals)))))
(symbol->string vals))))) attribs))
attribs)) "}")))
"}"))) css-rules))))
css-rules))))
(define hd-css (define hd-css
`(STYLE ((TYPE "text/css")) ,(css-rules->style))) `(style ([type "text/css"]) ,(css-rules->style)))
; LINKs for showing PLT icon
;; LINKs for showing PLT icon
(define hd-links (define hd-links
`((LINK ((REL "icon") (HREF "/help/servlets/plticon.ico") (TYPE "image/ico"))) `((link ([rel "icon"] [href "/help/servlets/plticon.ico"]
(LINK ((REL "SHORTCUT ICON") (HREF "/help/servlets/plticon.ico")))))) [type "image/ico"]))
(link ([rel "SHORTCUT ICON"] [href "/help/servlets/plticon.ico"])))))

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

@ -1,11 +1,2 @@
(module info (lib "infotab.ss" "setup") (module info (lib "infotab.ss" "setup")
(define name "Help Desk servlets private")) (define name "Help Desk servlets private"))

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

@ -1,40 +1,26 @@
(module read-doc mzscheme (module read-doc mzscheme
(require (lib "etc.ss")
(require (lib "etc.ss")) (lib "getinfo.ss" "setup")
(require (lib "getinfo.ss" "setup")) "util.ss"
"read-lines.ss"
(require "util.ss") "headelts.ss")
(require "read-lines.ss")
(require "headelts.ss")
(provide read-doc) (provide read-doc)
; extracts help desk message ;; extracts help desk message
(define (get-message coll) (define (get-message coll)
(with-handlers ; collection may not exist (with-handlers ([void (lambda _ #f)]) ; collection may not exist
((void (lambda _ #f))) ((get-info (list coll)) 'help-desk-message (lambda () #f))))
((get-info (list coll))
'help-desk-message
(lambda () #f))))
(define no-offset-format "file=~a&caption=~a") (define offset-format "file=~a&caption=~a&offset=~a#temp")
(define offset-format (string-append no-offset-format "&offset=~a#temp"))
(define (build-page file caption coll offset) (define (build-page file caption coll offset)
(let ([msg (get-message coll)]) (let ([msg (get-message coll)])
(if msg `(html (head (title "PLT Help Desk") ,hd-css)
`(HTML ,(if msg
(HEAD (TITLE "PLT Help Desk") `(body ,(format-collection-message msg)
,hd-css) (hr)
(BODY ,(read-lines file caption offset))
,(format-collection-message msg) `(body ,(read-lines file caption offset))))))
(HR)
,(read-lines file caption offset)))
`(HTML
(HEAD (TITLE "PLT Help Desk")
,hd-css)
(BODY
,(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])

176
collects/help/servlets/private/read-lines.ss
View File

@ -1,56 +1,39 @@
(module read-lines mzscheme (module read-lines mzscheme
(require (lib "etc.ss") "util.ss")
(require (lib "etc.ss")
(lib "pregexp.ss")
"util.ss")
(provide read-lines) (provide read-lines)
(define read-lines (define read-lines
(opt-lambda (file caption [offset #f]) (opt-lambda (file caption [offset #f])
(template caption (get-the-lines file offset)))) (template caption (get-the-lines file offset))))
(define (semi-flatten lst) (define (semi-flatten lst)
(if (null? lst) (if (null? lst)
'() '()
(cons (caar lst) (list* (caar lst) (cadar lst) (semi-flatten (cdr lst)))))
(cons (cadar lst) (define temp-anchor `(a ((name "temp")) ""))
(semi-flatten (cdr lst))))))
(define temp-anchor `(A ((NAME "temp")) ""))
(define (spacify s) (define (spacify s)
(if (and (string? s) (string=? s "")) (if (and (string? s) (string=? s ""))
" " ; to appease IE " " ; to appease IE
s)) s))
(define (template caption lines) (define (template caption lines)
`(TABLE ((CELLPADDING "0") `(table ([cellpadding "0"] [cellspacing "0"])
(CELLSPACING "0")) (b ,(with-color "blue" caption))
(B ,(with-color "blue" caption)) (p)
(P) (pre ([style "font-family:monospace"])
(PRE ((STYLE "font-family:monospace")) ;; use <BR>'s instead of newlines, for Opera don't put in a <BR>
; use <BR>'s instead of newlines, for Opera ;; for the temp-anchor, which wasn't a line in the source
; don't put in a <BR> for the temp-anchor, which wasn't a line in the source ,@(semi-flatten
,@(semi-flatten (map (lambda (ln)
(map (lambda (ln) (if (eq? ln temp-anchor)
(if (eq? ln temp-anchor) `(,ln "")
`(,ln "") `(,(spacify ln) (BR)))) lines)))))
`(,(spacify ln) (BR)))) lines)))))
(define eoregexp-str "($|\\s|(\\.(\\s|$))|>)")
(define url-regexp-base (string-append "://([^\\s]*)" eoregexp-str))
(define url-regexp-base "://([^\\s]*)($|\\s|(\\.(\\s|$))|>)")
(define trailing-regexp (pregexp "[\\s>)(\"]")) (define trailing-regexp (pregexp "[\\s>)(\"]"))
(define (make-url-regexp ty) (define (make-url-regexp ty)
(pregexp (pregexp (string-append ty url-regexp-base)))
(string-append
ty
url-regexp-base)))
(define http-regexp (make-url-regexp "http")) (define http-regexp (make-url-regexp "http"))
(define (http-format url) `(A ((HREF ,url)) ,url)) (define (http-format url) `(a ((href ,url)) ,url))
(define ftp-regexp (make-url-regexp "ftp")) (define ftp-regexp (make-url-regexp "ftp"))
(define ftp-format http-format) (define ftp-format http-format)
@ -59,57 +42,51 @@
[no-comma-chars "[^\\s)(<>\"',]"]) [no-comma-chars "[^\\s)(<>\"',]"])
(pregexp (string-append no-comma-chars chars "*" "@" chars "{3,}")))) (pregexp (string-append no-comma-chars chars "*" "@" chars "{3,}"))))
(define (email-format addr) (define (email-format addr)
`(A ((HREF ,(string-append "mailto:" addr))) ,addr)) `(a ((href ,(string-append "mailto:" addr))) ,addr))
(define (rtrim s) (define (rtrim s)
(let* ([presult (pregexp-replace* trailing-regexp s "")] (let* ([presult (pregexp-replace* trailing-regexp s "")]
[plen (string-length presult)] [plen (string-length presult)]
[qlen (sub1 plen)]) [qlen (sub1 plen)])
(if (and (> qlen 0) (if (and (> qlen 0) (char=? (string-ref presult qlen) #\.))
(char=? (string-ref presult qlen) (substring presult 0 qlen)
#\.)) presult)))
(substring presult 0 qlen)
presult)))
(define (process-for-urls line) (define (process-for-urls line)
(let loop ([built-line line]) (let loop ([built-line line])
(let ([curr-len (string-length built-line)]) (let ([curr-len (string-length built-line)])
(let-values (let-values ([(raw-indices formatter)
([(raw-indices formatter) (let regexp-loop ([regexps (list http-regexp
(let regexp-loop ([regexps (list http-regexp ftp-regexp
ftp-regexp email-regexp)]
email-regexp)] [formats (list http-format
[formats (list http-format ftp-format
ftp-format email-format)])
email-format)]) (if (null? regexps)
(if (null? regexps) (values #f #f)
(values #f #f) (let* ([curr-regexp (car regexps)]
(let* ([curr-regexp (car regexps)] [curr-formatter (car formats)]
[curr-formatter (car formats)] [match-indices (regexp-match-positions
[match-indices curr-regexp built-line)])
(pregexp-match-positions curr-regexp built-line)]) (if match-indices
(if match-indices (values match-indices curr-formatter)
(values match-indices curr-formatter) (regexp-loop (cdr regexps) (cdr formats))))))])
(regexp-loop (cdr regexps) (cdr formats))))))]) (if raw-indices
(if raw-indices (let* ([indices (car raw-indices)]
(let* ([indices (car raw-indices)] [string-start (car indices)]
[string-start (car indices)] [string-end (cdr indices)]
[string-end (cdr indices)] [raw-item (substring built-line string-start string-end)]
[raw-item [raw-item-len (string-length raw-item)]
(substring built-line [item (rtrim raw-item)]
string-start string-end)] [item-len (string-length item)])
[raw-item-len (string-length raw-item)] `(tt ,(substring built-line 0 string-start)
[item (rtrim raw-item)] ,(formatter item)
[item-len (string-length item)]) ,(substring raw-item ; text removed by rtrim
`(TT item-len
,(substring built-line 0 string-start) raw-item-len)
,(formatter item) ,(loop (substring built-line string-end
,(substring raw-item ; text removed by rtrim curr-len))))
item-len built-line)))))
raw-item-len)
,(loop (substring built-line string-end
curr-len))))
built-line)))))
(define (process-for-keywords line) (define (process-for-keywords line)
(let ([len (string-length line)]) (let ([len (string-length line)])
@ -123,23 +100,20 @@
(let-values ([(_1 _2 pos) (port-next-location port)]) (let-values ([(_1 _2 pos) (port-next-location port)])
pos))]) pos))])
(if dist (if dist
`(div (b ">" ,(color-highlight (substring line 1 dist))) `(div (b ">" ,(color-highlight (substring line 1 dist)))
,(substring line dist len)) ,(substring line dist len))
line)) line))
#f))) #f)))
; format line for doc.txt files ;; format line for doc.txt files
(define (process-doc-line line) (define (process-doc-line line)
(let ([key-result (process-for-keywords line)]) (let ([key-result (process-for-keywords line)])
(if key-result (if key-result key-result (process-for-urls line))))
key-result
(process-for-urls line))))
(define (get-the-lines file offset) (define (get-the-lines file offset)
(let* ([port (open-input-file file 'text)] (let* ([port (open-input-file file 'text)]
[doc-txt? (let ([len (string-length file)]) [doc-txt? (let ([len (string-length file)])
(string=? (substring file (- len 7) len) (string=? (substring file (- len 7) len) "doc.txt"))]
"doc.txt"))]
[process-line [process-line
(if doc-txt? (if doc-txt?
process-doc-line process-doc-line
@ -152,18 +126,14 @@
(reverse lines)) (reverse lines))
(loop (cons line lines)))))]) (loop (cons line lines)))))])
(if offset (if offset
(let loop ([lines lines] (let loop ([lines lines] [count 0])
[count 0]) (if (null? lines)
(if (null? lines) '()
'() (let ([len (add1 (string-length (car lines)))])
(let ([len (add1 (string-length (car lines)))]) ;; add1 because newline in source omitted
; add1 because newline in source omitted (if (>= count offset)
(if (>= count offset) (cons temp-anchor
(cons temp-anchor (if doc-txt? (map process-doc-line lines) lines))
(if doc-txt? (cons (process-line (car lines))
(map process-doc-line lines) (loop (cdr lines) (+ count len)))))))
lines)) (map process-line lines)))))
(cons (process-line (car lines))
(loop (cdr lines)
(+ count len)))))))
(map process-line lines)))))

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

@ -1,18 +1,14 @@
(module search-util mzscheme (module search-util mzscheme
(require (lib "string-constant.ss" "string-constants")) (require (lib "string-constant.ss" "string-constants"))
(provide (provide search-types search-type-default
search-types match-types match-type-default kind-types)
search-type-default
match-types
match-type-default
kind-types)
(define search-types (define search-types
`(("keyword" ,(string-constant plt:hd:search-for-keyword)) `(("keyword" ,(string-constant plt:hd:search-for-keyword))
("keyword-index" ,(string-constant plt:hd:search-for-keyword-or-index)) ("keyword-index" ,(string-constant plt:hd:search-for-keyword-or-index))
("keyword-index-text" ,(string-constant plt:hd:search-for-keyword-or-index-or-text)))) ("keyword-index-text"
,(string-constant plt:hd:search-for-keyword-or-index-or-text))))
(define search-type-default "keyword-index") (define search-type-default "keyword-index")

96
collects/help/servlets/private/util.ss
View File

@ -12,13 +12,15 @@
[stamp-collection [stamp-collection
(with-handlers ([exn:fail:filesystem? (lambda (exn) #f)]) (with-handlers ([exn:fail:filesystem? (lambda (exn) #f)])
(collection-path "repos-time-stamp"))]) (collection-path "repos-time-stamp"))])
(if (and stamp-collection (file-exists? (build-path stamp-collection "stamp.ss"))) (if (and stamp-collection
(format "~a-svn~a" mz-version (dynamic-require '(lib "stamp.ss" "repos-time-stamp") 'stamp)) (file-exists? (build-path stamp-collection "stamp.ss")))
(format "~a-svn~a" mz-version
(dynamic-require '(lib "stamp.ss" "repos-time-stamp") 'stamp))
mz-version))) mz-version)))
(define home-page (define home-page
`(A ((HREF "/servlets/home.ss") (TARGET "_top")) `(a ([href "/servlets/home.ss"] [target "_top"])
,(string-constant plt:hd:home))) ,(string-constant plt:hd:home)))
(define (get-pref/default pref default) (define (get-pref/default pref default)
(get-preference pref (lambda () default))) (get-preference pref (lambda () default)))
@ -31,17 +33,17 @@
(put-preferences names vals)) (put-preferences names vals))
(define search-height-default "85") (define search-height-default "85")
(define search-bg-default "lightsteelblue") (define search-bg-default "lightsteelblue")
(define search-text-default "black") (define search-text-default "black")
(define search-link-default "darkblue") (define search-link-default "darkblue")
(define *the-highlight-color* "forestgreen") (define *the-highlight-color* "forestgreen")
; string xexpr ... -> xexpr ;; string xexpr ... -> xexpr
(define (with-color color . s) (define (with-color color . s)
`(FONT ((COLOR ,color)) ,@s)) `(font ([color ,color]) ,@s))
; xexpr ... -> xexpr ;; xexpr ... -> xexpr
(define (color-highlight . s) (define (color-highlight . s)
(apply with-color *the-highlight-color* s)) (apply with-color *the-highlight-color* s))
@ -53,69 +55,42 @@
(with-handlers ([exn:fail:filesystem? (lambda (x) #f)]) (with-handlers ([exn:fail:filesystem? (lambda (x) #f)])
(collection-path "repos-time-stamp")))))) (collection-path "repos-time-stamp"))))))
;; can-keep? : byte -> boolean
;; source rfc 2396
(define (can-keep? i)
(or (<= (char->integer #\a) i (char->integer #\z))
(<= (char->integer #\A) i (char->integer #\Z))
(<= (char->integer #\0) i (char->integer #\9))
(memq i (map char->integer
'(#\- #\_ #\; #\. #\! #\~ #\* #\' #\( #\))))))
; string string -> xexpr ; string string -> xexpr
(define (collection-doc-link coll txt) (define (collection-doc-link coll txt)
(let ([coll-file (build-path (let ([coll-file (build-path (collection-path coll) "doc.txt")])
(collection-path coll) "doc.txt")])
(if (file-exists? coll-file) (if (file-exists? coll-file)
`(A ((HREF `(a ((href
,(format ,(format
"/servlets/doc-anchor.ss?file=~a&name=~a&caption=Documentation for the ~a collection" "~a?file=~a&name=~a&caption=Documentation for the ~a collection"
(uri-encode (path->string coll-file)) "/servlets/doc-anchor.ss"
coll (uri-encode (path->string coll-file))
coll))) coll
,txt) coll)))
""))) ,txt)
"")))
; (listof string) -> string ;; (listof string) -> string
; result is forward-slashed web path ;; result is forward-slashed web path
; e.g. ("foo" "bar") -> "foo/bar" ;; e.g. ("foo" "bar") -> "foo/bar"
(define (fold-into-web-path lst) (define (fold-into-web-path lst)
(foldr (lambda (s a) (foldr (lambda (s a) (if a (string-append s "/" a) s)) #f lst))
(if a
(string-append s "/" a)
s))
#f
lst))
;; ??
;(define (text-frame) "_top")
(define (format-collection-message s) (define (format-collection-message s)
`(B ((STYLE "color:green")) ,s)) `(b ((style "color:green")) ,s))
(define nl (string #\newline))
(define (make-javascript . ss) (define (make-javascript . ss)
`(SCRIPT ((LANGUAGE "Javascript")) `(script ([language "Javascript"])
,(make-comment ,(make-comment (apply string-append "\n"
(apply string-append (map (lambda (s) (string-append s "\n")) ss)))))
nl
(map (lambda (s)
(string-append s nl))
ss)))))
(define (redir-javascript k-url) (define (redir-javascript k-url)
(make-javascript (make-javascript "function redir() {"
"function redir() {" (string-append " document.location.href=\"" k-url "\"")
(string-append "}"))
" document.location.href=\"" k-url "\"")
"}"))
(define (onload-redir secs) (define (onload-redir secs)
(string-append (string-append "setTimeout(\"redir()\","
"setTimeout(\"redir()\"," (number->string (* secs 1000)) ")"))
(number->string (* secs 1000))
")"))
(provide/contract (provide/contract
[fold-into-web-path ((listof string?) . -> . string?)]) [fold-into-web-path ((listof string?) . -> . string?)])
@ -133,7 +108,6 @@
collection-doc-link collection-doc-link
home-page home-page
format-collection-message format-collection-message
nl
plt-version plt-version
make-javascript make-javascript
redir-javascript redir-javascript

31
collects/help/servlets/release/bugs.ss
View File

@ -1,25 +1,18 @@
(module bugs mzscheme (module bugs mzscheme
(require (lib "string.ss")) (require (lib "string.ss")
"../private/util.ss"
(require "../private/util.ss") "../private/headelts.ss"
(require "../private/headelts.ss") (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)
(report-errors-to-browser send/finish)
(define stupid-internal-define-syntax (report-errors-to-browser send/finish)) `(html
(head ,hd-css ,@hd-links (title "Known Bugs"))
`(HTML (body
(HEAD ,hd-css (h1 "Known Bugs in PLT Scheme")
,@hd-links (a ([name "bugs"] [value "Bugs"]))
(TITLE "Known Bugs"))
(BODY
(H1 "Known Bugs in PLT Scheme")
(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/") (a ([href "http://bugs.plt-scheme.org/query/"] [target "_top"])
(TARGET "_top")) "PLT bug report query page")) "."))) "PLT bug report query page")) ".")))

144
collects/help/servlets/release/license.ss
View File

@ -2,34 +2,23 @@
(require "../private/util.ss" (require "../private/util.ss"
"../private/headelts.ss" "../private/headelts.ss"
(lib "uri-codec.ss" "net") (lib "uri-codec.ss" "net")
(lib "dirs.ss" "setup")) (lib "dirs.ss" "setup")
(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 (make-item ss) (define (make-item ss)
`(UL `(ul (li ,@(map (lambda (s) `(div ,s (br))) ss))))
(LI
,@(map (lambda (s)
`(DIV ,s (BR)))
ss))))
(define copyright-year 2006) (define copyright-year 2006)
(define (start initial-request) (define (start initial-request)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "License"))
(HEAD ,hd-css (body
,@hd-links (a ([name "lic"] [value "License"]))
(TITLE "License")) (b "PLT Software") (br)
(BODY (b ,(format "Copyright (c) ~a PLT Scheme Inc." copyright-year))
(A ((NAME "lic") (VALUE "License"))) (p)
(B "PLT Software") (BR)
(B ,(format "Copyright (c) ~a PLT Scheme Inc." copyright-year))
(P)
"PLT software is distributed under the GNU Library General Public " "PLT software is distributed under the GNU Library General Public "
" License (LGPL). This means you can link PLT software (such as " " License (LGPL). This means you can link PLT software (such as "
"MzScheme or MrEd) into proprietary applications, provided you follow " "MzScheme or MrEd) into proprietary applications, provided you follow "
@ -37,63 +26,66 @@
"software; if you distribute a modified version, you must distribute it " "software; if you distribute a modified version, you must distribute it "
"under the terms of the LGPL, which in particular means that you must " "under the terms of the LGPL, which in particular means that you must "
"release the source code for the modified software. See " "release the source code for the modified software. See "
(A ((HREF ,(format "/servlets/doc-anchor.ss?name=COPYING.LIB&caption=Copying PLT software&file=~a" (a ([href ,(format "/servlets/doc-anchor.ss?~a&file=~a"
"name=COPYING.LIB&caption=Copying PLT software"
(uri-encode (uri-encode
(path->string (path->string
(simplify-path (simplify-path (build-path (find-doc-dir)
(build-path (find-doc-dir) "release-notes" "COPYING.LIB"))))))) "release-notes"
"COPYING.LIB")))))])
"COPYING.LIB") "COPYING.LIB")
" for more information." " for more information."
(P) (p)
"PLT software includes or extends the following copyrighted material:" "PLT software includes or extends the following copyrighted material:"
(P) (p)
,@(map make-item ,@(map
`(("DrScheme" make-item
"Copyright (c) 1995-2006 PLT" `(("DrScheme"
,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year) ,(format "Copyright (c) 1995-~a PLT" copyright-year)
"All rights reserved.") ,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year)
("MrEd" "All rights reserved.")
"Copyright (c) 1995-2006 PLT" ("MrEd"
,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year) ,(format "Copyright (c) 1995-~a PLT" copyright-year)
"All rights reserved.") ,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year)
("MzScheme" "All rights reserved.")
"Copyright (c) 1995-2006 PLT" ("MzScheme"
,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year) ,(format "Copyright (c) 1995-~a PLT" copyright-year)
"All rights reserved.") ,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year)
("libscheme" "All rights reserved.")
"Copyright (c) 1994 Brent Benson" ("libscheme"
"All rights reserved.") "Copyright (c) 1994 Brent Benson"
("wxWindows" "All rights reserved.")
"Copyright (c) 1994 Artificial Intelligence Applications Institute, The University of Edinburgh" ("wxWindows"
"All rights reserved.") "Copyright (c) 1994 Artificial Intelligence Applications Institute, The University of Edinburgh"
("wxWindows Xt" "All rights reserved.")
"Copyright (c) 1994 Artificial Intelligence Applications Institute, The University of Edinburgh" ("wxWindows Xt"
"Copyright (c) 1995 GNU (Markus Holzem)" "Copyright (c) 1994 Artificial Intelligence Applications Institute, The University of Edinburgh"
"All rights reserved.") "Copyright (c) 1995 GNU (Markus Holzem)"
("Conservative garbage collector" "All rights reserved.")
"Copyright (c) 1988, 1989 Hans-J. Boehm, Alan J. Demers" ("Conservative garbage collector"
"Copyright (c) 1991-1996 Xerox Corporation" "Copyright (c) 1988, 1989 Hans-J. Boehm, Alan J. Demers"
"Copyright (c) 1996-1999 Silicon Graphics" "Copyright (c) 1991-1996 Xerox Corporation"
"Copyright (c) 1999-2001 by Hewlett-Packard Company" "Copyright (c) 1996-1999 Silicon Graphics"
"All rights reserved.") "Copyright (c) 1999-2001 by Hewlett-Packard Company"
("Collector C++ extension by Jesse Hull and John Ellis" "All rights reserved.")
"Copyright (c) 1994 Xerox Corporation" ("Collector C++ extension by Jesse Hull and John Ellis"
"All rights reserved.") "Copyright (c) 1994 Xerox Corporation"
("The A List" "All rights reserved.")
"Copyright (c) 1997-2000 Kyle Hammond." ("The A List"
"All rights reserved.") "Copyright (c) 1997-2000 Kyle Hammond."
("Independent JPEG Group library" "All rights reserved.")
"Copyright (c) 1991-1998 Thomas G. Lane." ("Independent JPEG Group library"
"All rights reserved.") "Copyright (c) 1991-1998 Thomas G. Lane."
("libpng" "All rights reserved.")
"Copyright (c) 2000-2002 Glenn Randers-Pehrson" ("libpng"
"All rights reserved.") "Copyright (c) 2000-2002 Glenn Randers-Pehrson"
("zlib" "All rights reserved.")
"Copyright (c) 1995-2002 Jean-loup Gailly and Mark Adler" ("zlib"
"All rights reserved.") "Copyright (c) 1995-2002 Jean-loup Gailly and Mark Adler"
("GNU MP Library" "All rights reserved.")
"Copyright (c) 1992, 1993, 1994, 1996 by Free Software Foundation, Inc.") ("GNU MP Library"
("GNU lightning" "Copyright (c) 1992, 1993, 1994, 1996 by Free Software Foundation, Inc.")
"Copyright (c) 1994, 1995, 1996, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.") ("GNU lightning"
("GNU Classpath" "Copyright (c) 1994, 1995, 1996, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.")
"GNU Public License with special exception"))))))) ("GNU Classpath"
"GNU Public License with special exception")))))))

61
collects/help/servlets/release/notes.ss
View File

@ -5,51 +5,38 @@
(lib "dirs.ss" "setup") (lib "dirs.ss" "setup")
"../private/util.ss" "../private/util.ss"
"../private/headelts.ss") "../private/headelts.ss")
(define (make-entry s) (define (make-entry s)
(let* ([label (car s)] (let* ([label (car s)]
[dir (cadr s)] [dir (cadr s)]
[filename (caddr s)] [filename (caddr s)]
[file (build-path (find-doc-dir) "release-notes" dir filename)]) [file (build-path (find-doc-dir) "release-notes" dir filename)])
(if (file-exists? file) (if (file-exists? file)
`(LI (A ((HREF ,(format "/servlets/doc-anchor.ss?file=~a&name=~a&caption=~a" `(li (a ([href ,(format
(uri-encode (path->string file)) "/servlets/doc-anchor.ss?file=~a&name=~a&caption=~a"
filename (uri-encode (path->string file))
label))) filename
,label)) label)])
#f))) ,label))
#f)))
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "PLT release notes"))
(HEAD ,hd-css (body
,@hd-links (h1 "Release Notes for PLT Scheme version " ,(version))
(TITLE "PLT release notes")) (a ([name "relnotes"] [VALUE "Release notes"]))
(H1 "Release Notes for PLT Scheme version " ,(version)) "Detailed release notes:"
(A ((NAME "relnotes") (VALUE "Release notes"))) (ul
"Detailed release notes:" ,@(filter
(UL values ; delete #f entries
,@(filter (map make-entry
(lambda (x) x) ; delete #f entries '(("DrScheme release notes" "drscheme" "HISTORY")
(map make-entry ("Teachpack release notes" "teachpack" "HISTORY")
'(("DrScheme release notes" ("MzScheme version 300 notes" "mzscheme" "MzScheme_300.txt")
"drscheme" "HISTORY") ("MzScheme release notes" "mzscheme" "HISTORY")
("Teachpack release notes" ("MrEd release notes" "mred" "HISTORY")
"teachpack" "HISTORY") ("Stepper release notes" "stepper" "HISTORY")
("MzScheme version 300 notes" ("MrFlow release notes" "mrflow" "HISTORY")))))))))
"mzscheme" "MzScheme_300.txt")
("MzScheme release notes"
"mzscheme" "HISTORY")
("MrEd release notes"
"mred" "HISTORY")
("Stepper release notes"
"stepper" "HISTORY")
("MrFlow release notes"
"mrflow" "HISTORY"))))))))

33
collects/help/servlets/release/patches.ss
View File

@ -1,26 +1,21 @@
(module patches mzscheme (module patches mzscheme
(require "../private/headelts.ss" (require "../private/headelts.ss"
"../private/util.ss") "../private/util.ss"
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "Downloadable Patches"))
(HEAD ,hd-css (body
,@hd-links (h1 "Downloadable Patches")
(TITLE "Downloadable Patches")) (a ([name "patches"] [value "Downloadable patches"]))
(H1 "Downloadable Patches") "The following Web page may contain downloadable patches to fix "
(A ((NAME="patches") (VALUE "Downloadable patches"))) "serious bugs in version " ,(version) " of the PLT software:"
"The following Web page may contain downloadable patches to fix serious bugs in " (p)
"version " ,(version) " of the PLT software:" nbsp nbsp
(P) ,(let ([url (format "http://download.plt-scheme.org/patches/~a/"
'nbsp 'nbsp (version))])
,(let ([url (format "http://download.plt-scheme.org/patches/~a/" (version))]) `(a ([href ,url] [target "_top"]) ,url))))))
`(A ((HREF ,url)
(TARGET "_top")) ,url)))))

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

@ -1,35 +1,32 @@
(module releaseinfo mzscheme (module releaseinfo mzscheme
(require "private/util.ss") (require "private/util.ss"
(require "private/headelts.ss") "private/headelts.ss"
(lib "servlet.ss" "web-server"))
(define (link-stuff url txt) (define (link-stuff url txt)
`(LI (B (A ((HREF ,url)) ,txt)))) `(li (b (a ([href ,url]) ,txt))))
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(HTML `(html
(HEAD ,hd-css (head ,hd-css ,@hd-links (title "Release Information"))
,@hd-links (body
(TITLE "Release Information")) (h1 "Release Information")
(BODY (p)
(H1 "Release Information") (i "Version: " ,(plt-version))
(P) (p)
(I "Version: " ,(plt-version)) (ul ,(link-stuff "/servlets/release/license.ss" "License")
(P) ,(link-stuff "/servlets/release/notes.ss" "Release Notes")
(UL ,(link-stuff "/servlets/release/bugs.ss" "Known Bugs")
,(link-stuff "/servlets/release/license.ss" "License") (li (a ([mzscheme "((dynamic-require '(lib |bug-report.ss| |help|) 'help-desk:report-bug))"])
,(link-stuff "/servlets/release/notes.ss" "Release Notes") (b "Submit a bug report")))
,(link-stuff "/servlets/release/bugs.ss" "Known Bugs") ,(link-stuff "/servlets/release/patches.ss" "Downloadable Patches"))
(li (a ((mzscheme "((dynamic-require '(lib |bug-report.ss| |help|) 'help-desk:report-bug))")) (p)
(b "Submit a bug report"))) "The PLT software is installed on this machine at" (br)
,(link-stuff "/servlets/release/patches.ss" "Downloadable Patches")) (pre nbsp nbsp
(P) ,(let-values ([(base file dir?)
"The PLT software is installed on this machine at" (BR) (split-path (collection-path "mzlib"))])
(PRE 'nbsp nbsp
,(let-values ([(base file dir?) (split-path (collection-path "mzlib"))])
(path->string base))))))) (path->string base)))))))

113
collects/help/servlets/research/why.ss
View File

@ -1,67 +1,60 @@
(module why mzscheme (module why mzscheme
(require "../private/headelts.ss" (require "../private/headelts.ss"
"../private/util.ss") "../private/util.ss"
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "Why DrScheme?"))
(HEAD ,hd-css (body
,@hd-links (h1 "Why DrScheme?")
(TITLE "Why DrScheme?")) "Teaching introductory computing courses with Scheme, or any other"
(BODY " functional programming language, facilitates many conceptual tasks"
(H1 "Why DrScheme?") " and greatly enhances the appeal of computer science. Specifically,"
"Teaching introductory computing courses with Scheme, or any other " " students can implement many interesting programs with just a small"
"functional programming language, facilitates many conceptual tasks " " subset of the language. The execution of a functional program can be"
"and greatly enhances the appeal of computer science. Specifically, " " explained with simple reduction rules that students mostly know from"
"students can implement many interesting programs with just a " " secondary school. Interactive implementations allow for quick"
"small subset of the language. The execution of a functional program " " feedback to the programmers andmake the development of small"
"can be explained with simple reduction rules that students mostly " " functions a pleasant experience."
"know from secondary school. Interactive implementations allow " (p)
"for quick feedback to the programmers andmake the development of " "Unfortunately, the poor quality of the available environments for"
"small functions a pleasant experience." " functional languages negates these advantages. Typical"
(P) " implementations accept too many definitions, that is, definitions"
"Unfortunately, the poor quality of the available environments " " that are syntactically well-formed in the sense of the full language"
"for functional languages negates these advantages. Typical " " but meaningless for beginners. The results are inexplicable behavior,"
"implementations accept too many definitions, that is, definitions " " incomprehensible run-time errors, or confusing type error messages."
"that are syntactically well-formed in the sense of the full " " The imperative nature of read-eval-print loops often introduces"
"language but meaningless for beginners. The results are " " subtle bugs into otherwise perfect program developments. Scheme, in"
"inexplicable behavior, incomprehensible run-time errors, or " " particular, suffers from an adherence to Lisp's output traditions,"
"confusing type error messages. The imperative nature of " " which often produces confusing effects. In many cases students,"
"read-eval-print loops often introduces subtle bugs into " " especially those familiar with commercial C++ environments, mistake"
"otherwise perfect program developments. Scheme, in particular, " " these problems for problems with the functional approach and reject"
"suffers from an adherence to Lisp's output traditions, which " " the approach itself."
"often produces confusing effects. In many cases students, " (p)
"especially those familiar with commercial C++ environments, " "To overcome this obstacle, we have developed a new programming"
"mistake these problems for problems with the functional " " environment for Scheme. It fully integrates a (graphics-enriched)"
"approach and reject the approach itself." " editor, a multi-lingual parser that can process a hierarchy of"
(P) " syntactically restrictive variants of Scheme, a functional"
"To overcome this obstacle, we have developed a new programming " " read-eval-print loop, and an algebraically sensible printer. The"
"environment for Scheme. It fully integrates a (graphics-enriched) " " environment catches the typical syntactic mistakes of beginners and"
"editor, a multi-lingual parser that can process a hierarchy " " pinpoints the exact source location of run-time exceptions. The new"
"of syntactically restrictive variants of Scheme, a functional " " programming environment also provides an algebraic stepper and a"
"read-eval-print loop, and an algebraically sensible printer. " " static debugger. The former reduces Scheme programs, including"
"The environment catches the typical syntactic mistakes of " " programs with assignment and control effects, to values (and"
"beginners and pinpoints the exact source location of run-time " " effects). The static debugger infers what set of values an"
"exceptions. The new programming environment also provides " " expression may produce and how values flow from expressions into"
"an algebraic stepper and a static debugger. The former reduces " " variables. It exposes potential safety violations and, upon demand"
"Scheme programs, including programs with assignment and " " from the programmer, explains its reasoning by drawing value"
"control effects, to values (and effects). The static debugger " " flowgraphs over the program text. Preliminary experience with the"
"infers what set of values an expression may produce and how " " environment shows that students find it helpful and that they greatly"
"values flow from expressions into variables. It exposes potential " " prefer it to shell-based or Emacs-based systems."
"safety violations and, upon demand from the programmer, explains " (p)
"its reasoning by drawing value flowgraphs over the program text. " "A paper that discusses DrScheme in more detail is available in the"
"Preliminary experience with the environment shows that " " paper: "
"students find it helpful and that they greatly prefer it to " (a ([href "http://www.ccs.neu.edu/scheme/pubs#jfp01-fcffksf"]
"shell-based or Emacs-based systems." [target "_top"])
(P) "DrScheme: A Programming Environment for Scheme") "."))))
"A paper that discusses DrScheme in "
"more detail is available in the paper: "
(A ((HREF "http://www.ccs.neu.edu/scheme/pubs#jfp01-fcffksf")
(TARGET "_top")) "DrScheme: A Programming Environment for Scheme") "."))))

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

@ -1,39 +1,32 @@
(module resources mzscheme (module resources mzscheme
(require "private/headelts.ss") (require "private/headelts.ss"
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "External Resources"))
(HEAD ,hd-css (body
,@hd-links (h1 "External Resources")
(TITLE "External Resources")) (p)
(BODY
(H1 "External Resources")
(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) (p)
(UL (ul (li (b (a ([href "resources/teachscheme.ss"])
(LI (B (A ((HREF "resources/teachscheme.ss")) "TeachScheme! Workshops"))
"TeachScheme! Workshops")) ": Free summer program")
": Free summer program") (li (b (a ([href "resources/libext.ss"]) "Libraries"))
(LI (B (A ((HREF "resources/libext.ss")) ": From PLT and contributors")
"Libraries")) (li (b (a ([href "resources/maillist.ss"]) "Mailing Lists"))
": From PLT and contributors") ": How to subscribe"))
(LI (B (A ((HREF "resources/maillist.ss")) (p)
"Mailing Lists")) ": How to subscribe"))
(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: " (A ((HREF "http://www.schemers.org/") "and libraries: "
(TARGET "_top")) "http://www.schemers.org/") ".")))) (a ([href "http://www.schemers.org/"] [target "_top"])
"http://www.schemers.org/") "."))))

47
collects/help/servlets/resources/libext.ss
View File

@ -1,38 +1,33 @@
(module libext mzscheme (module libext mzscheme
(require "../private/headelts.ss" (require "../private/headelts.ss"
"../private/util.ss") "../private/util.ss"
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "Libraries"))
(HEAD ,hd-css (body
,@hd-links (h1 "Libraries")
(TITLE "Libraries")) (a ([name "libraries"] [value "extensions"]))
(BODY (a ([name "mrspidey"] [value "mrspidey"]))
(H1 "Libraries") (a ([name "static debugger"] [value "static debugger"]))
(A ((NAME "libraries") (VALUE "extensions"))) (a ([name "mysterx"] [value "mysterx"]))
(A ((NAME "mrspidey") (VALUE "mrspidey"))) (a ([name "mzcom"] [value "mzcom"]))
(A ((NAME "static debugger") (VALUE "static debugger"))) (a ([name "COM"] [value "COM"]))
(A ((NAME "mysterx") (VALUE "mysterx"))) (a ([name "srpersist"] [value "srpersist"]))
(A ((NAME "mzcom") (VALUE "mzcom"))) (a ([name "ODBC"] [value "ODBC"]))
(A ((NAME "COM") (VALUE "COM"))) (a ([name "databases"] [value "databases"]))
(A ((NAME "srpersist") (VALUE "srpersist")))
(A ((NAME "ODBC") (VALUE "ODBC")))
(A ((NAME "databases") (VALUE "databases")))
"Many libraries and extensions are available for PLT software. " "Many libraries and extensions are available for PLT software. "
"See the " "See the "
(A ((HREF "http://www.cs.utah.edu/plt/develop/") (a ([href "http://www.cs.utah.edu/plt/develop/"]
(TARGET "_top")) "PLT libraries and extensions") [target "_top"])
"PLT libraries and extensions")
" page for a comprehensive listing." " page for a comprehensive listing."
(P) (p)
"If you write a PLT library or extension, we would like to " "If you write a PLT library or extension, we would like to hear about"
"hear about it! Please send a message about it to " " it! Please send a message about it to Matthew Flatt at "
"Matthew Flatt at "
(TT "mflatt@cs.utah.edu") " so we can list it. " (TT "mflatt@cs.utah.edu") " so we can list it. "
"Thanks for your efforts!")))) "Thanks for your efforts!"))))

120
collects/help/servlets/resources/maillist.ss
View File

@ -1,78 +1,82 @@
(module maillist mzscheme (module maillist mzscheme
(require "../private/headelts.ss") (require "../private/headelts.ss"
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "Mailing Lists"))
(HEAD ,hd-css (body
,@hd-links (a ([name "mail"] [value "mailing lists"]))
(TITLE "Mailing Lists")) (h1 "Mailing Lists")
(BODY "PLT maintains two English-language mailing lists: one for"
(A ((NAME "mail") (VALUE "mailing lists"))) " announcements, the other for discussion. There is a discussion list"
(H1 "Mailing Lists") " in Spanish."
"PLT maintains two English-language mailing lists: one for announcements, " (p)
"the other for discussion. There is a discussion list in Spanish." (hr)
(P) (p)
(HR) (b "Announcements List") (br)
(P) "The announcement-only list is designed for people who need to track"
(B "Announcements List") (BR) " releases and patches. The list is moderated. There are a handful"
"The announcement-only list is designed for people who need to " " of postings a year."
"track releases and patches. The list is moderated. " (p)
"There are a handful of postings a year." "To subscribe to " (tt "plt-announce@list.cs.brown.edu") ", visit the "
(P)
"To subscribe to " (TT "plt-announce@list.cs.brown.edu") ", visit the "
"Web page " "Web page "
(BLOCKQUOTE (blockquote
(A ((HREF "http://list.cs.brown.edu/mailman/listinfo/plt-announce/") (a ([href "http://list.cs.brown.edu/mailman/listinfo/plt-announce/"]
(TARGET "_top")) "http://list.cs.brown.edu/mailman/listinfo/plt-announce/")) [target "_top"])
"http://list.cs.brown.edu/mailman/listinfo/plt-announce/"))
" or send email to " " or send email to "
(BLOCKQUOTE (blockquote
(A ((HREF "mailto:plt-announce-request@list.cs.brown.edu")) (a ([href "mailto:plt-announce-request@list.cs.brown.edu"])
"plt-announce-request@list.cs.brown.edu")) "plt-announce-request@list.cs.brown.edu"))
" with the word `help' in the subject or body of the message. " " with the word `help' in the subject or body of the message."
"You'll get back a message with instructions." " You'll get back a message with instructions."
(P) (p)
(HR) (hr)
(P) (p)
(B "Discussion List") (BR) (b "Discussion List") (br)
"If you have problems with installation, or questions about " "If you have problems with installation, or questions about "
"using PLT Scheme, send mail to the list " "using PLT Scheme, send mail to the list "
(BLOCKQUOTE (blockquote
(A ((HREF "mailto:plt-scheme@list.cs.brown.edu")) "plt-scheme@list.cs.brown.edu")) (a ([href "mailto:plt-scheme@list.cs.brown.edu"])
(P) "plt-scheme@list.cs.brown.edu"))
"Only subscribers can post to the list. To subscribe, visit the Web page " (p)
(BLOCKQUOTE "Only subscribers can post to the list."
(A ((HREF "http://list.cs.brown.edu/mailman/listinfo/plt-scheme/") " To subscribe, visit the Web page "
(TARGET "_top")) "http://list.cs.brown.edu/mailman/listinfo/plt-scheme/")) (blockquote
(a ([href "http://list.cs.brown.edu/mailman/listinfo/plt-scheme/"]
[target "_top"])
"http://list.cs.brown.edu/mailman/listinfo/plt-scheme/"))
" or send email to " " or send email to "
(BLOCKQUOTE (blockquote
(A ((HREF "mailto:plt-scheme-request@list.cs.brown.edu")) "plt-scheme-request@list.cs.brown.edu")) (a ((href "mailto:plt-scheme-request@list.cs.brown.edu"))
"plt-scheme-request@list.cs.brown.edu"))
" with the word `help' in the subject or body of the message. " " with the word `help' in the subject or body of the message. "
"You'll get back a message with instructions." "You'll get back a message with instructions."
(P) (p)
(HR) (hr)
(P) (p)
(A ((NAME "mail-es") (VALUE "Spanish mailing lists"))) (a ([name "mail-es"] [value "Spanish mailing lists"]))
(A ((NAME "mail-es2") (VALUE "Lista de Correo"))) (a ([name "mail-es2"] [value "Lista de Correo"]))
(B "Lista de Correo") (BR) (b "Lista de Correo") (br)
"Si tienes problemas con la instalación o preguntas sobre el " "Si tienes problemas con la instalación o preguntas sobre el uso"
"uso de PLT Scheme, envía un mensaje a la lista " " de PLT Scheme, envía un mensaje a la lista "
(BLOCKQUOTE (blockquote
(A ((HREF "mailto:plt-scheme-es@list.cs.brown.edu")) "plt-scheme-es@list.cs.brown.edu")) (a ([href "mailto:plt-scheme-es@list.cs.brown.edu"])
"plt-scheme-es@list.cs.brown.edu"))
"Para reducir la recepción de mensajes no deseados (SPAM), " "Para reducir la recepción de mensajes no deseados (SPAM), "
"hemos adoptado la política de que sólo los suscriptores a la lista " "hemos adoptado la política de que sólo los suscriptores a la lista "
"pueden enviar mensajes. Para suscribirte, visita la página de Web " "pueden enviar mensajes. Para suscribirte, visita la página de Web "
(BLOCKQUOTE (blockquote
(A ((HREF "http://list.cs.brown.edu/mailman/listinfo/plt-scheme-es/") (a ([href "http://list.cs.brown.edu/mailman/listinfo/plt-scheme-es/"]
(TARGET "_top")) "http://list.cs.brown.edu/mailman/listinfo/plt-scheme-es/")) [target "_top"])
"http://list.cs.brown.edu/mailman/listinfo/plt-scheme-es/"))
" o envía un mensaje a " " o envía un mensaje a "
(BLOCKQUOTE (blockquote
(A ((HREF "mailto:plt-scheme-es-request@list.cs.brown.edu")) "plt-scheme-es-request@list.cs.brown.edu")) (a ([href "mailto:plt-scheme-es-request@list.cs.brown.edu"])
"plt-scheme-es-request@list.cs.brown.edu"))
" con la palabra `help' en el asunto o en el cuerpo de tu mensaje. " " con la palabra `help' en el asunto o en el cuerpo de tu mensaje. "
"Recibirás un mensaje de regreso con instrucciones.")))) "Recibirás un mensaje de regreso con instrucciones."))))

29
collects/help/servlets/resources/teachscheme.ss
View File

@ -1,28 +1,22 @@
(module teachscheme mzscheme (module teachscheme mzscheme
(require "../private/headelts.ss") (require "../private/headelts.ss"
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "TeachScheme! Workshops"))
(HEAD ,hd-css (body
,@hd-links (h1 "TeachScheme! Workshops")
(TITLE "TeachScheme! Workshops")) (a ([name "workshops"] [value "TeachScheme! workshops"]))
(BODY
(H1 "TeachScheme! Workshops")
(A ((NAME "workshops") (VALUE "TeachScheme! workshops")))
"TeachScheme! is a free summer workshop for high school teachers. " "TeachScheme! is a free summer workshop for high school teachers. "
"Its goal is to bridge the gulf between high school and " "Its goal is to bridge the gulf between high school and "
"college-level computing curricula. In the workshop, programming " "college-level computing curricula. In the workshop, programming "
"is taught as an algebraic problem-solving process, and computing " "is taught as an algebraic problem-solving process, and computing "
"is the natural generalization of grade-school level calculating." "is the natural generalization of grade-school level calculating."
(P) (p)
"Students who learn to design programs properly learn to " "Students who learn to design programs properly learn to "
"analyze a problem statement; express its essence, abstractly " "analyze a problem statement; express its essence, abstractly "
"and with examples; formulate statements and comments in a " "and with examples; formulate statements and comments in a "
@ -30,7 +24,8 @@
"light of checks and tests; and pay attention to details. " "light of checks and tests; and pay attention to details. "
"As a result, all students benefit, those who wish to study computing " "As a result, all students benefit, those who wish to study computing "
"as well as those who just wish to explore the subject." "as well as those who just wish to explore the subject."
(P) (p)
"For more information, see the " "For more information, see the "
(A ((HREF "http://www.teach-scheme.org/Workshops/") (a ([href "http://www.teach-scheme.org/Workshops/"]
(TARGET "_top")) "TeachScheme! Workshops page") ".")))) [TARGET "_top"])
"TeachScheme! Workshops page") "."))))

263
collects/help/servlets/results.ss
View File

@ -20,13 +20,10 @@ is stored in a module top-level and that's namespace-specific.
"../private/search.ss" "../private/search.ss"
"../private/manuals.ss" "../private/manuals.ss"
"../private/get-help-url.ss" "../private/get-help-url.ss"
(lib "string-constant.ss" "string-constants")) (lib "string-constant.ss" "string-constants")
"private/util.ss"
(require "private/util.ss") "private/search-util.ss"
(require "private/search-util.ss") "private/headelts.ss")
(require "private/headelts.ss")
(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)
@ -34,16 +31,11 @@ is stored in a module top-level and that's namespace-specific.
(define (start initial-request) (define (start initial-request)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
(let () (let ()
; doc subcollection name -> boolean ;; doc subcollection name -> boolean
(define (search-type->search-level st) (define (search-type->search-level st)
(let loop ([n 0] (let loop ([n 0] [lst (map car search-types)])
[lst (map car search-types)]) (when (null? lst) (raise 'bad-search-type))
(when (null? lst) (if (string=? (car lst) st) n (loop (add1 n) (cdr lst)))))
(raise 'bad-search-type))
(if (string=? (car lst) st)
n
(loop (add1 n) (cdr lst)))))
(define search-responses #f) (define search-responses #f)
@ -60,9 +52,10 @@ is stored in a module top-level and that's namespace-specific.
(unless max-reached (unless max-reached
(set! max-reached #t) (set! max-reached #t)
(set! search-responses (set! search-responses
(cons `(B ,(with-color (cons `(b ,(with-color
"red" "red"
(string-constant plt:hd:search-stopped-too-many-matches))) (string-constant
plt:hd:search-stopped-too-many-matches)))
search-responses))) search-responses)))
(k #f))) (k #f)))
@ -70,19 +63,16 @@ is stored in a module top-level and that's namespace-specific.
(unless max-reached (unless max-reached
(set! last-header s) (set! last-header s)
(set! search-responses (set! search-responses
(cons `(B ((STYLE "font-family:Verdana,Helvetica,sans-serif")) (list* `(b ([style "font-family:Verdana,Helvetica,sans-serif"])
,s) ,s)
(cons `(BR) `(br)
search-responses))))) search-responses))))
(define (set-current-kind! s key) (define (set-current-kind! s key)
(set! current-kind (set! current-kind (cadr (assoc s kind-types))))
(cadr (assoc s kind-types))))
(define exp-web-root (define exp-web-root
(explode-path (explode-path (normalize-path (find-collects-dir))))
(normalize-path
(find-collects-dir))))
(define web-root-len (length exp-web-root)) (define web-root-len (length exp-web-root))
(define (keyword-string? ekey) (define (keyword-string? ekey)
@ -91,37 +81,32 @@ is stored in a module top-level and that's namespace-specific.
(define (pretty-label label ekey) (define (pretty-label label ekey)
(if (keyword-string? ekey) (if (keyword-string? ekey)
`(FONT `(font ([face "monospace"])
((FACE "monospace")) ;; boldface keyword occurrences
; boldface keyword occurrences ,@(let ([mpos (regexp-match-positions (non-regexp ekey) label)])
,@(let ([mpos (regexp-match-positions (non-regexp ekey) label)]) (if mpos
(if mpos (let* ([item (car mpos)]
(let* ([item (car mpos)] [start (car item)]
[start (car item)] [stop (cdr item)])
[stop (cdr item)]) (list (substring label 0 start)
(list `(b ,(substring label start stop))
(substring label 0 start) (substring label stop (string-length label))))
`(B ,(substring label start stop)) (list label))))
(substring label stop label))
(string-length label))))
(list label))))
label))
(define (maybe-extract-coll s) (define (maybe-extract-coll s)
(let ([len (string-length s)]) (let ([len (string-length s)])
(if (and (> len 17) (if (and (> len 17)
(string=? (substring s 0 4) "the ") (string=? (substring s 0 4) "the ")
(string=? (substring s (- len 11) len) (string=? (substring s (- len 11) len) " collection"))
" collection")) (substring s 4 (- len 11))
(substring s 4 (- len 11)) s)))
s)))
(define no-anchor-format (define no-anchor-format
(string-append (string-append "/servlets/doc-anchor.ss?"
"/servlets/doc-anchor.ss?" "file=~a&"
"file=~a&" "caption=~a&"
"caption=~a&" "name=~a"))
"name=~a"))
(define with-anchor-format (define with-anchor-format
(string-append no-anchor-format "&offset=~a#temp")) (string-append no-anchor-format "&offset=~a#temp"))
@ -130,38 +115,31 @@ is stored in a module top-level and that's namespace-specific.
(format "Documentation for the ~a collection" coll)) (format "Documentation for the ~a collection" coll))
(define (make-search-link href label src ekey) (define (make-search-link href label src ekey)
`(TABLE ((CELLSPACING "0") `(table ([cellspacing "0"] [cellpadding "0"])
(CELLPADDING "0")) (tr (td (div ([align "left-outdent"])
(TR (a ([href ,href]) ,(pretty-label label ekey))
(TD " in \"" ,src "\"")))))
(DIV ((ALIGN "left-outdent"))
(A ((HREF ,href)) ,(pretty-label label ekey))
" in "
"\"" ,src "\"")))))
;; doc-txt? : string -> boolean ;; doc-txt? : string -> boolean
(define (doc-txt? str) (regexp-match "doc\\.txt$" str)) (define (doc-txt? str) (regexp-match "doc\\.txt$" str))
(define (make-html-href page-label path) (define (make-html-href page-label path)
(let ([anchored-path (make-anchored-path page-label path)]) (let ([anchored-path (make-anchored-path page-label path)])
(cond (cond [(servlet-path? path) anchored-path]
[(servlet-path? path) [(doc-txt? (path->string path)) ; collection doc.txt
anchored-path] (let ([maybe-coll (maybe-extract-coll last-header)])
[(doc-txt? (path->string path)) ; collection doc.txt (format no-anchor-format
(let ([maybe-coll (maybe-extract-coll last-header)]) (uri-encode anchored-path)
(format (uri-encode (make-caption maybe-coll))
no-anchor-format maybe-coll))]
(uri-encode anchored-path) [else ; manual, so have absolute path
(uri-encode (make-caption maybe-coll)) (get-help-url path page-label)])))
maybe-coll))]
[else ; manual, so have absolute path
(get-help-url path page-label)])))
;; make-anchored-path : string path -> string ;; make-anchored-path : string path -> string
; page-label is #f or a bytes that labels an HTML anchor ;; page-label is #f or a bytes that labels an HTML anchor
; path is either an absolute pathname (possibly not normalized) ;; path is either an absolute pathname (possibly not normalized)
; in the format of the native OS, or, in the case of Help Desk ;; in the format of the native OS, or, in the case of Help Desk
; servlets, a forward-slashified path beginning with "/servlets/" ;; servlets, a forward-slashified path beginning with "/servlets/"
(define (make-anchored-path page-label path) (define (make-anchored-path page-label path)
(let ([normal-path (let ([normal-path
(if (servlet-path? path) (if (servlet-path? path)
@ -174,83 +152,69 @@ is stored in a module top-level and that's namespace-specific.
(string-append (path->string normal-path) "#" page-label) (string-append (path->string normal-path) "#" page-label)
(path->string normal-path)))) (path->string normal-path))))
; path is absolute pathname ; path is absolute pathname
(define (make-text-href page-label path) (define (make-text-href page-label path)
(let* ([maybe-coll (maybe-extract-coll last-header)] (let* ([maybe-coll (maybe-extract-coll last-header)]
[hex-path (uri-encode (path->string (normalize-path path)))] [hex-path (uri-encode (path->string (normalize-path path)))]
[hex-caption (if (eq? maybe-coll last-header) [hex-caption (if (eq? maybe-coll last-header)
hex-path hex-path
(uri-encode (make-caption maybe-coll)))] (uri-encode (make-caption maybe-coll)))]
[offset (or (and (number? page-label) [offset (or (and (number? page-label) page-label)
page-label)
0)]) 0)])
(format (format with-anchor-format
with-anchor-format hex-path hex-caption (uri-encode maybe-coll) offset)))
hex-path
hex-caption
(uri-encode maybe-coll)
offset)))
(define (html-entry? path) (define (html-entry? path)
(and (not (suffixed? path #"doc.txt")) (and (not (suffixed? path #"doc.txt"))
(or (eq? current-kind 'html) (or (eq? current-kind 'html) (suffixed? path #".html"))))
(suffixed? path #".html"))))
(define (suffixed? path suffix) (define (suffixed? path suffix)
(let* ([path-bytes (path->bytes path)] (let* ([path-bytes (path->bytes path)]
[path-len (bytes-length path-bytes)] [path-len (bytes-length path-bytes)]
[suffix-len (bytes-length suffix)]) [suffix-len (bytes-length suffix)])
(and (path-len . >= . suffix-len) (and (path-len . >= . suffix-len)
(bytes=? (subbytes path-bytes (bytes=? (subbytes path-bytes (- path-len suffix-len) path-len)
(- path-len suffix-len)
path-len)
suffix)))) suffix))))
(define (goto-lucky-entry ekey label src path page-label key) (define (goto-lucky-entry ekey label src path page-label key)
(let* ([href (if (html-entry? path) (let ([href (if (html-entry? path)
(make-html-href page-label path) (make-html-href page-label path)
(make-text-href page-label path))]) (make-text-href page-label path))])
(send/finish (send/finish (redirect-to href))))
(redirect-to href))))
(define (add-entry ekey label src path page-label key) (define (add-entry ekey label src path page-label key)
(let* ([entry (if (html-entry? path) (let* ([entry
(make-search-link (if (html-entry? path)
(make-html-href page-label path) (make-search-link (make-html-href page-label path)
label src ekey) label src ekey)
(make-search-link (make-search-link (make-text-href page-label path)
(make-text-href page-label path) label src ekey))])
label src ekey))]) (set! search-responses (cons entry search-responses))))
(set! search-responses
(cons entry search-responses))))
(define (make-results-page search-string lang-name items regexp? exact?) (define (make-results-page search-string lang-name items regexp? exact?)
(let-values ([(string-finds finds) (build-string-finds/finds search-string regexp? exact?)]) (let-values ([(string-finds finds)
`(HTML (build-string-finds/finds search-string regexp? exact?)])
(HEAD ,hd-css `(html
,@hd-links (head ,hd-css ,@hd-links (title "PLT Help Desk search results"))
(TITLE "PLT Help Desk search results")) (body
(BODY
(h1 "Search Results") (h1 "Search Results")
(h2 (h2
,@(if lang-name ,@(if lang-name
(list "Language: " (with-color "firebrick" lang-name) '(br)) (list "Language: " (with-color "firebrick" lang-name) '(br))
'()) '())
,@(let ([single-key ,@(let ([single-key
(lambda (sf) (lambda (sf)
(with-color "firebrick" (format " \"~a\"" sf)))]) (with-color "firebrick" (format " \"~a\"" sf)))])
(cond (cond [(null? string-finds) '()]
[(null? string-finds) '()] [(null? (cdr string-finds))
[(null? (cdr string-finds)) (list "Key: " (single-key (car string-finds)))]
(list "Key: " (single-key (car string-finds)))] [else
[else (cons "Keys: " (map single-key string-finds))])))
(cons "Keys: " (map single-key string-finds))]))) (br)
(BR)
,@items)))) ,@items))))
(define (search-results lucky? search-string search-type match-type manuals doc-txt? lang-name) (define (search-results lucky? search-string search-type match-type
manuals doc-txt? lang-name)
(set! search-responses '()) (set! search-responses '())
(set! max-reached #f) (set! max-reached #f)
(let* ([search-level (search-type->search-level search-type)] (let* ([search-level (search-type->search-level search-type)]
@ -273,18 +237,15 @@ is stored in a module top-level and that's namespace-specific.
search-string search-string
lang-name lang-name
(if (string? result) ; error message (if (string? result) ; error message
`((H2 ((STYLE "color:red")) ,result)) `((h2 ([style "color:red"]) ,result))
(reverse search-responses)) (reverse search-responses))
regexp? regexp?
exact-match?)]) exact-match?)])
html)) html))
(define empty-search-page (define empty-search-page
`(HTML `(html (head (title "Empty search string in PLT Help Desk"))
(HEAD (body (h2 "Empty search string"))))
(TITLE "Empty search string in PLT Help Desk"))
(BODY
(H2 "Empty search string"))))
(define (lucky-search? bindings) (define (lucky-search? bindings)
(with-handlers ([exn:fail? (lambda _ #f)]) (with-handlers ([exn:fail? (lambda _ #f)])
@ -292,19 +253,15 @@ is stored in a module top-level and that's namespace-specific.
(not (string=? result "false"))))) (not (string=? result "false")))))
(define (maybe-update-box b s) (define (maybe-update-box b s)
(unless (string=? s "") (unless (string=? s "") (set-box! b s)))
(set-box! b s)))
(define (convert-manuals manuals) (define (convert-manuals manuals)
(cond (if manuals
[manuals (let ([parsed (read-from-string manuals)])
(let ([parsed (read-from-string manuals)]) (if (and (list? parsed) (andmap bytes? parsed))
(cond (map bytes->path parsed)
[(and (list? parsed) (map car (find-doc-names))))
(andmap bytes? parsed)) (map car (find-doc-names))))
(map bytes->path parsed)]
[else (map car (find-doc-names))]))]
[else (map car (find-doc-names))]))
(let* ([bindings (request-bindings initial-request)] (let* ([bindings (request-bindings initial-request)]
[maybe-get (lambda (sym) [maybe-get (lambda (sym)
@ -324,19 +281,15 @@ is stored in a module top-level and that's namespace-specific.
[manuals (maybe-get 'manuals)] [manuals (maybe-get 'manuals)]
[doc.txt (maybe-get 'doctxt)] [doc.txt (maybe-get 'doctxt)]
[lang-name (maybe-get 'langname)]) [lang-name (maybe-get 'langname)])
(cond (if (or (not search-string) (= (string-length search-string) 0))
[(or (not search-string) (= (string-length search-string) 0)) empty-search-page
empty-search-page] (search-results (lucky-search? bindings)
[else search-string
(search-results (or search-type "keyword-index")
(lucky-search? bindings) (or match-type "containing-match")
search-string (convert-manuals manuals)
(or search-type "keyword-index") (cond [(not doc.txt) #t]
(or match-type "containing-match") [(equal? doc.txt "false") #f]
(convert-manuals manuals) [else #t])
(cond lang-name)))])))))
[(not doc.txt) #t]
[(equal? doc.txt "false") #f]
[else #t])
lang-name)]))])))))

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

@ -1,56 +1,44 @@
(module doc mzscheme (module doc mzscheme
(require "../private/headelts.ss" (require "../private/headelts.ss"
"../private/util.ss") "../private/util.ss"
(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)
(define (make-header-text s) (define (make-header-text s)
(color-highlight `(H2 () ,s))) (color-highlight `(h2 () ,s)))
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "Documentation"))
(HEAD ,hd-css (body
,@hd-links (h1 "Documentation")
(TITLE "Documentation")) (a ([name "docs"] [value "Documentation"]))
(BODY
(H1 "Documentation")
(A ((NAME "docs") (VALUE "Documentation")))
,(make-header-text "How to use DrScheme") ,(make-header-text "How to use DrScheme")
(A ((HREF "/servlets/howtodrscheme.ss")) "DrScheme") (a ([href "/servlets/howtodrscheme.ss"]) "DrScheme")
" provides information about using the DrScheme development " " provides information about using the DrScheme development environment."
"environment."
,(make-header-text "Languages and Libraries") ,(make-header-text "Languages and Libraries")
"Language and library documentation is distributed among " "Language and library documentation is distributed among several"
"several manuals, plus a number of plain-text files " " manuals, plus a number of plain-text files describing small library"
"describing small library collections." " collections."
(P) (p)
"When you " (A ((HREF "/servlets/howtouse.ss#search")) "search") "When you " (a ([href "/servlets/howtouse.ss#search"]) "search") ","
", Help Desk groups the results by manual and collection. " " Help Desk groups the results by manual and collection. The manuals"
"The manuals are ordered from the most-used documentation " " are ordered from the most-used documentation (e.g., R5RS Scheme) to"
"(e.g., R5RS Scheme) to the least-used (e.g., MzScheme " " the least-used (e.g., MzScheme internals), and all manuals precede"
"internals), and all manuals precede library collections." " library collections."
(P) (p)
"The PLT distribution archive includes a partial set of " "The PLT distribution archive includes a partial set of documentation."
"documentation. A hyperlink in this partial set may refer " " A hyperlink in this partial set may refer to a manual that is"
"to a manual that is missing from the distribution. " " missing from the distribution. If you follow such a link, Help Desk"
"If you follow such a link, Help Desk provides a special " " provides a special page for automatically downloading and installing"
"page for automatically downloading and installing the " " the missing manual. For certain manuals, the PLT distribution"
"missing manual. For certain manuals, the PLT distribution " " includes a searchable index file rather than the whole manual, so a"
"includes a searchable index file rather than the whole " " search result link might refer to a missing manual."
"manual, so a search result link might refer to a " (ul (li (b (a ([href "/servlets/manuals.ss"]) "Manuals"))
"missing manual." ": List the currently installed and uninstalled manuals"))
(UL (LI (B (A ((href "/servlets/manuals.ss"))
"Manuals"))
": List the currently installed and uninstalled manuals"))
,(make-header-text "Searching") ,(make-header-text "Searching")
(A ((HREF "/servlets/howtouse.ss#search")) "Searching") (a ([href "/servlets/howtouse.ss#search"]) "Searching")
" in Help Desk finds documenation from all sources, " " in Help Desk finds documenation from all sources, including "
"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."))))

218
collects/help/servlets/scheme/how.ss
View File

@ -6,122 +6,110 @@
"../../private/installed-components.ss" "../../private/installed-components.ss"
(lib "uri-codec.ss" "net") (lib "uri-codec.ss" "net")
(lib "servlet.ss" "web-server")) (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)
(define stupid-internal-define-syntax (report-errors-to-browser send/finish)) (report-errors-to-browser send/finish)
(send/finish
(define soft-page `(html
`(HTML (head ,hd-css ,@hd-links (title "Software & Components"))
(HEAD ,hd-css (body
,@hd-links (h1 "Software & Components")
(TITLE "Software & Components")) ,(color-highlight `(h2 "DrScheme"))
(BODY (a ([name "dr2"] [value "DrScheme programming environment"]))
(H1 "Software & Components") (a ([name "dr3"] [value "Running Scheme"]))
,(color-highlight `(H2 "DrScheme")) (b "DrScheme")
(A ((NAME "dr2") (VALUE "DrScheme programming environment"))) " is a user-friendly environment for creating and running"
(A ((NAME "dr3") (VALUE "Running Scheme"))) " Scheme programs."
(B "DrScheme") (p)
" is a user-friendly environment for creating and running " "DrScheme's default "
"Scheme programs." (a ((href "/servlets/scheme/what.ss")) "language")
(P) " is Beginning Student. To change the language, select the "
"DrScheme's default " (b (tt "Choose Language...")) " item in the "
(A ((HREF "/servlets/scheme/what.ss")) "language") (b (tt "Language")) " menu."
" is Beginning Student. To change the language, select " (p)
"the " (B (TT "Choose Language...")) " item in the " "On this machine, the DrScheme program is "
(B (TT "Language")) " menu." (tt ,(path->string (mred-program-launcher-path "DrScheme"))) "."
(P) (p)
"On this machine, the DrScheme program is " "For more information, see "
(TT ,(path->string (mred-program-launcher-path "DrScheme"))) "." (a ((href "/servlets/howtodrscheme.ss")) "DrScheme") "."
(P) (p)
"For more information, see " ,(color-highlight `(h2 "MzScheme and MrEd"))
(A ((HREF "/servlets/howtodrscheme.ss")) "DrScheme") "." (a ((name "mz") (value "MzScheme interpreter")))
(P) (a ((name "mr") (value "MrEd interpreter")))
,(color-highlight `(H2 "MzScheme and MrEd")) "The " (b "MzScheme") " and " (b "MrEd")
(A ((NAME "mz") (VALUE "MzScheme interpreter"))) " executables run programs written in the MzScheme and MrEd variants,"
(A ((NAME "mr") (VALUE "MrEd interpreter"))) " respectively, of the PLT Scheme "
"The " (B "MzScheme") (a ((href "/servlets/scheme/what.ss")) "language") "."
" and " (B "MrEd") " executables run programs written " (p)
"in the MzScheme and MrEd variants, respectively, of the " "Create a MzScheme or MrEd program using the DrScheme development"
"PLT Scheme " (A ((HREF "/servlets/scheme/what.ss")) "language") " environment. Then, use the MzScheme or MrEd executable to run the"
"." " program in its deployed setting."
(P) (p)
"Create a MzScheme or MrEd program using the DrScheme " "On this machine, the MzScheme program is at "
"development environment. Then, use the MzScheme or MrEd " (tt ,(path->string (mzscheme-program-launcher-path "MzScheme")))
"executable to run the program in its deployed setting." ", and MrEd is at "
(P) (tt ,(path->string (mred-program-launcher-path "MrEd"))) "."
"On this machine, the MzScheme program is at " (p)
(TT ,(path->string (mzscheme-program-launcher-path "MzScheme"))) ", and " "For more information, see " ,(main-manual-page "mzscheme")
"MrEd is at " " and " ,(main-manual-page "mred")
(TT ,(path->string (mred-program-launcher-path "MrEd"))) "." (p)
(P) ,(color-highlight `(h2 "mzc"))
"For more information, see " (a ((name "mzc2") (value "mzc compiler")))
,(main-manual-page "mzscheme") (a ((name "mzc3") (value "Compiling")))
" and " "The " (b "mzc") " command-line tool creates stand-alone executables,"
,(main-manual-page "mred") " compiles MzScheme and MrEd programs to byte-code files, compiles"
(P) " programs to native code using a C compiler "
,(color-highlight `(H2 "mzc")) ,(if (memq (system-type) '(macosx windows))
(A ((NAME "mzc2") (VALUE "mzc compiler"))) "(not useful on this machine, since MzScheme's just-in-time compiler works), "
(A ((NAME "mzc3") (VALUE "Compiling"))) "(useful on on machines where MzScheme's just-in-time compiler is unavailable), ")
"The " (B "mzc") " command-line tool creates stand-alone " "bundles distribution archives, and performs many other tasks."
"executables, compiles MzScheme and MrEd programs to byte-code files, compiles " (p)
"programs to native code using a C compiler " "On this machine, the mzc program is at "
,(if (memq (system-type) '(macosx windows)) (tt ,(path->string (mzscheme-program-launcher-path "mzc"))) "."
"(not useful on this machine, since MzScheme's just-in-time compiler works), " (p)
"(useful on on machines where MzScheme's just-in-time compiler is unavailable), ") "For more information, see "
"bundles distribution archives, and performs many other tasks." ,(main-manual-page "mzc") ". "
(P) (p)
"On this machine, the mzc program is at " (a ((name "help") (value "help-desk")))
(TT ,(path->string (mzscheme-program-launcher-path "mzc"))) "." ,(color-highlight `(h2 "Help Desk"))
(P) "Help Desk provides information about PLT Software in a user-friendly,"
"For more information, see " " searchable environment. Help Desk can run by itself, or within"
,(main-manual-page "mzc") ". " " DrScheme (via the " (b (tt "Help")) " menu)."
(P) "You are currently reading this text in Help Desk."
(A ((NAME "help") (VALUE "help-desk"))) (p)
,(color-highlight `(H2 "Help Desk")) "On this machine, the Help Desk program is at "
"Help Desk provides information about PLT Software in a " (tt ,(path->string (mred-program-launcher-path "Help Desk"))) "."
"user-friendly, searchable environment. " (p)
"Help Desk can run by itself, or within DrScheme " (a ((name "setup-plt")))
"(via the " ,(color-highlight `(h2 "Setup PLT"))
(B (TT "Help")) " menu)." (a ((name "setup") (value "Setup PLT program")))
"You are currently reading this text in Help Desk." (a ((name "setup2") (value "setup-plt program")))
(P) (a ((href ,(format "/servlets/doc-anchor.ss?file=~a&name=~a&caption=~a"
"On this machine, the Help Desk program is at " (uri-encode
(TT ,(path->string (mred-program-launcher-path "Help Desk"))) "." (path->string
(P) (simplify-path
(A ((NAME "setup-plt"))) (build-path (collection-path "mzlib")
,(color-highlight `(H2 "Setup PLT")) 'up "setup" "doc.txt"))))
(A ((NAME "setup") (VALUE "Setup PLT program"))) "Setup PLT"
(A ((NAME "setup2") (VALUE "setup-plt program"))) "Document for the setup collection")))
(A ((HREF ,(format "/servlets/doc-anchor.ss?file=~a&name=~a&caption=~a" "Setup PLT")
(uri-encode " performs certain installation duties, such as compiling DrScheme's"
(path->string " source code to make DrScheme start faster."
(simplify-path (p)
(build-path (collection-path "mzlib") 'up "setup" "doc.txt")))) "Setup PLT also unpacks and installs downloadable "
"Setup PLT" (tt ".plt") " distributions, such as the MrFlow "
"Document for the setup collection"))) "distribution archive. However, Help Desk automatically runs Setup PLT"
"Setup PLT") " when you use it to download a "
" performs certain installation duties, such as compiling " (tt ".plt") " file."
"DrScheme's source code to make DrScheme start faster." (p)
(P) "On this machine, the Setup PLT program is at "
"Setup PLT also unpacks and installs downloadable " (tt ,(path->string (mzscheme-program-launcher-path "Setup PLT"))) "."
(TT ".plt") " distributions, such as the MrFlow " (p)
"distribution archive. However, Help Desk automatically " (a ((name "installed-components") (value "Installed Components")))
"runs Setup PLT when you use it to download a " ,(color-highlight `(h2 "Additional Installed Components"))
(tt ".plt") " file." (a ((name "installed-components")))
(P) (i "The list below was generated by searching the set of installed"
"On this machine, the Setup PLT program is at " " libraries.")
(TT ,(path->string (mzscheme-program-launcher-path "Setup PLT"))) "." (ul ,@(help-desk:installed-components)))))))
(P)
(A ((NAME "installed-components") (VALUE "Installed Components")))
,(color-highlight `(H2 "Additional Installed Components"))
(A ((NAME "installed-components")))
(I
"The list below was generated by searching the set "
"of installed libraries.")
(UL ,@(help-desk:installed-components)))))
(send/finish soft-page)))

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

@ -1,67 +1,60 @@
(module langlevels mzscheme (module langlevels mzscheme
(require "../private/headelts.ss") (require "../private/headelts.ss"
(require "../../private/manuals.ss") "../../private/manuals.ss"
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html
`(HTML (head ,hd-css ,@hd-links (title "A Note on Language Levels"))
(HEAD ,hd-css (body
,@hd-links (h1 "A Note on Language Levels")
(TITLE "A Note on Language Levels") ) (a ([name "language levels"] [value "language levels"]))
(BODY (p)
(H1 "A Note on Language Levels")
(A ((NAME "language levels") (VALUE "language levels")))
(P)
"DrScheme presents Scheme via a hierarchy of " "DrScheme presents Scheme via a hierarchy of "
,(manual-entry "drscheme" "languages" "language levels") ,(manual-entry "drscheme" "languages" "language levels") "."
"." (p)
(P) "We designed the teaching languages based upon our observations of"
"We designed the teaching languages based upon our observations of " " students in classes and labs over several years. Beginning students"
"students in classes and labs over several years. Beginning students " " tend to make small notational mistakes that produce "
"tend to make small notational mistakes that produce "
(em "syntactically legal") " Scheme programs with a " (em "syntactically legal") " Scheme programs with a "
(em "radically different meaning") " than the one intended. " (em "radically different meaning") " than the one intended."
"Even the best students are then surprised by error messages, " " Even the best students are then surprised by error messages, which"
"which might mention concepts not covered in classes, or other " " might mention concepts not covered in classes, or other unexpected"
"unexpected behavior." " behavior."
(P) (p)
"The teaching levels are not ideal for instructors. " "The teaching levels are not ideal for instructors. They are"
"They are particularly unhelpful for implementing libraries " " particularly unhelpful for implementing libraries to support course"
"to support course material. But the levels were not designed " " material. But the levels were not designed for this purpose."
"for this purpose. Instead, in order to protect students from " " Instead, in order to protect students from unwanted mistakes and to"
"unwanted mistakes and to provide them with libraries based " " provide them with libraries based on language constructs outside of"
"on language constructs outside of their knowledge, DrScheme " " their knowledge, DrScheme provides an interface designed specially"
"provides an interface designed specially for instructors: " " for instructors: "
,(manual-entry "drscheme" "DrScheme Teachpacks" "Teachpacks") ". " ,(manual-entry "drscheme" "DrScheme Teachpacks" "Teachpacks") "."
"A Teachpack is a " " A Teachpack is a "
,(manual-entry "mzscheme" "modules" "module") ,(manual-entry "mzscheme" "modules" "module")
" that is implemented in Full Scheme; it imports the functions " " that is implemented in Full Scheme; it imports the functions from the"
"from the teaching languages and the graphics run-time library. " " teaching languages and the graphics run-time library. The provided"
"The provided values are automatically imported to the run-time " " values are automatically imported to the run-time of the"
"of the read-eval-print loop when the student clicks the " " read-eval-print loop when the student clicks the "
,(manual-entry "drscheme" "Execute button" "Execute") ". " ,(manual-entry "drscheme" "Execute button" "Execute") "."
"In short, Teachpacks provide students the best of both worlds: " " In short, Teachpacks provide students the best of both worlds:"
"protection from wanton error messages and unexpected behavior, " " protection from wanton error messages and unexpected behavior, and"
"and powerful support from the instructor." " powerful support from the instructor."
(P) (p)
"We strongly encourage instructors to employ language levels and " "We strongly encourage instructors to employ language levels and"
"Teachpacks. In our experience, the restriction of the teaching " " Teachpacks. In our experience, the restriction of the teaching"
"languages do not interfere with students' programming needs up to, " " languages do not interfere with students' programming needs up to,"
"and including, junior-level courses on programming languages. " " and including, junior-level courses on programming languages. It"
"It gives students a more productive learning experience than " " gives students a more productive learning experience than raw Scheme,"
"raw Scheme, and simplifies the interface between library and " " and simplifies the interface between library and user code."
"user code." (p)
(P) "We also strongly encourage students to point out this page to their"
"We also strongly encourage students to point out this page to " " instructors."
"their instructors." (p)
(P) "Please follow the links on this page for more information. If you"
"Please follow the links on this page for more information. " " have additional questions or comments, please contact us at "
"If you have additional questions or comments, please contact " (a ((href "mailto:scheme@plt-scheme.org")) "scheme@plt-scheme.org")
"us at " (A ((HREF "mailto:scheme@plt-scheme.org")) "scheme@plt-scheme.org") ".")))) "."))))

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

@ -1,60 +1,36 @@
(module misc mzscheme (module misc mzscheme
(require (lib "servlet.ss" "web-server")) (require (lib "servlet.ss" "web-server")
(require "../private/headelts.ss" "../private/headelts.ss"
"../private/util.ss") "../private/util.ss")
;; (listof string string) -> xexpr
; (listof string string) -> xexpr
(define (make-link-line url/txt) (define (make-link-line url/txt)
(let ([url (car url/txt)] (let ([url (car url/txt)]
[txt (cadr url/txt)]) [txt (cadr url/txt)])
`(LI () (B () (A ((HREF ,(string-append `(li (b (a ([href ,(string-append "/servlets/scheme/misc/" url)])
"/servlets/scheme/misc/" ,txt)))))
url))) ,txt)))))
(define links (define links
'(("standalone.ss" '(("standalone.ss" "How to build a stand-alone executable")
"How to build a stand-alone executable") ("graphics.ss" "How to write graphics programs")
("graphics.ss" ("script.ss" "How to write Unix shell scripts")
"How to write graphics programs") ("batch.ss" "How to write Windows batch files")
("script.ss" ("cgi.ss" "How to write CGI scripts")
"How to write Unix shell scripts") ("activex.ss" "How to use ActiveX components")
("batch.ss" ("database.ss" "How to connect to databases")
"How to write Windows batch files") ("system.ss" "How to call low-level system routines")))
("cgi.ss"
"How to write CGI scripts")
("activex.ss"
"How to use ActiveX components")
("database.ss"
"How to connect to databases")
("system.ss"
"How to call low-level system routines")))
(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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html (head ,hd-css ,@hd-links (TITLE "How to do things in Scheme"))
`(HTML (body
(HEAD ,hd-css (h1 "How to do things in Scheme")
,@hd-links (ul ,@(map make-link-line links))
(TITLE "How to do things in Scheme")) (p)
(BODY "If you did't find what you're looking for in the list above, try "
(H1 "How to do things in Scheme") (a ((href "/servlets/howtouse.ss#search")) "searching")
(UL " in Help Desk. Also, check "
,@(map make-link-line links)) (a ((href "http://www.htus.org/")) (i "How to Use Scheme"))
(P) "."))))
"If you did't find what you're looking for in the "
"list above, try")
" "
(A ((HREF "/servlets/howtouse.ss#search")) "searching")
" "
"in Help Desk. "
"Also, check "
(a ((href "http://www.htus.org/")) (i "How to Use Scheme"))
".")))

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

@ -6,129 +6,98 @@
(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 (standout-text s)
(with-color "forestgreen" `(B ,s)))
(define (start initial-request) (define (start initial-request)
(report-errors-to-browser send/finish)
(define stupid-internal-define-syntax `(html
(report-errors-to-browser send/finish)) (head ,hd-css ,@hd-links (title "Scheme Languages"))
(body
(define (standout-text s) (h1 "Scheme Languages")
(with-color "forestgreen" `(B ,s))) (a ([name "scheme"] [value "Language Family"]))
(a ([name "r5rs"] [value "r5rs"]))
`(HTML (a ([name "language levels"] [value "language levels"]))
(HEAD ,hd-css ,@hd-links (TITLE "Scheme Languages"))
(BODY
(H1 "Scheme Languages")
(A ([NAME "scheme"] [VALUE "Language Family"]))
(A ([NAME "r5rs"] [VALUE "r5rs"]))
(A ([NAME "language levels"] [VALUE "language levels"]))
"From the introduction of " ,(main-manual-page "r5rs") " (R5RS):" "From the introduction of " ,(main-manual-page "r5rs") " (R5RS):"
(P) (p)
(DL (DD "Scheme is a statically scoped and properly " (dl (dd "Scheme is a statically scoped and properly tail-recursive"
"tail-recursive dialect of the Lisp programming " " dialect of the Lisp programming language [...] designed to"
"language [...] designed to have an exceptionally " " have an exceptionally clear and simple semantics and few"
"clear and simple semantics and few different ways " " different ways to form expressions. A wide variety of"
"to form expressions. A wide variety of programming " " programming paradigms, including imperative, functional, and"
"paradigms, including imperative, functional, and " " message passing styles, find convenient expression in"
"message passing styles, find convenient expression " " Scheme."))
"in Scheme.")) (p)
(P) "DrScheme supports many dialects of Scheme. The following dialects are"
"DrScheme supports many dialects of Scheme. " " specifically designed for teaching computer science. In DrScheme's "
"The following dialects are specifically designed for " (a ([href "/servlets/scheme/what.ss#lang-sel"])
"teaching computer science. In DrScheme's "
(A ([HREF "/servlets/scheme/what.ss#lang-sel"])
"language selection menu") "language selection menu")
", they are found under the heading " (B "How to Design Programs") "." ", they are found under the heading " (b "How to Design Programs") "."
(UL (ul (li (a ([name "beg"] [value "Beginning Student language"]))
(LI ,(standout-text "Beginning Student")
(A ([NAME "beg"] [VALUE "Beginning Student language"])) " is a pedagogical version of Scheme that is tailored for"
,(standout-text "Beginning Student") " beginning computer science students.")
" is a pedagogical version of Scheme " (li (a ([name "begla"]
"that is tailored for beginning computer " [value "Beginning Student with List Abbreviations language"]))
"science students.") ,(standout-text "Beginning Student with List Abbreviations")
(LI " extends Beginning Student with convenient (but potentially"
(A ([NAME "begla"] [VALUE "Beginning Student with List Abbreviations language"])) " confusing) ways to write lists, including quasiquote.")
,(standout-text "Beginning Student with List Abbreviations") (li (a ([name "int"] [value "Intermediate Student language"]))
" extends Beginning Student with convenient " ,(standout-text "Intermediate Student")
"(but potentially confusing) ways to write lists, " " adds local bindings and higher-order functions.")
"including quasiquote.") (li (a ([name "intlam"]
(LI [value "Intermediate Student with Lambda language"]))
(A ([NAME "int"] [VALUE "Intermediate Student language"])) ,(standout-text "Intermediate Student with Lambda")
,(standout-text "Intermediate Student") " adds anonymous functions.")
" adds local bindings and higher-order functions.") (li (a ([name "adv"] [value "Advanced Student language"]))
(LI ,(standout-text "Advanced Student")
(A ([NAME "intlam"] [VALUE "Intermediate Student with Lambda language"])) " adds mutable state."))
,(standout-text "Intermediate Student with Lambda")
" adds anonymous functions.")
(LI
(A ([NAME "adv"] [VALUE "Advanced Student language"]))
,(standout-text "Advanced Student")
" adds mutable state."))
"The " "The "
,(standout-text "Essentials of Programming Languages") ,(standout-text "Essentials of Programming Languages")
" language is designed for use with the MIT Press " " language is designed for use with the MIT Press textbook with that"
"textbook with that name." " name."
(P) (p)
"Other dialects are designed for practicing programmers. " "Other dialects are designed for practicing programmers. The "
"The " (A ([NAME "r5rs2"] [VALUE "R5RS Scheme language"])) (a ([name "r5rs2"] [value "R5RS Scheme language"]))
,(standout-text "R5RS") ,(standout-text "R5RS")
" language is a standard dialect of Scheme that is " " language is a standard dialect of Scheme that is defined by the "
"defined by the "
,(main-manual-page "r5rs") ". " ,(main-manual-page "r5rs") ". "
(A ([NAME "full"] [VALUE "PLT Scheme language"])) (a ([name "full"] [value "PLT Scheme language"]))
"In DrScheme's " "In DrScheme's "
(A ([HREF "/servlets/scheme/what.ss#lang-sel"]) (a ([href "/servlets/scheme/what.ss#lang-sel"])
"language selection menu") "language selection menu")
", the following languages " ", the following languages are found under the heading " (b "PLT") ":"
"are found under the heading " (B "PLT") ":" (ul (li ,(standout-text "Textual (MzScheme)") " is a superset of R5RS"
(UL " Scheme. In addition to the the base Scheme language, PLT"
(LI " Scheme provides exceptions, threads, objects, modules,"
,(standout-text "Textual (MzScheme)") " components, regular expressions, TCP support, filesystem"
" is a superset of R5RS Scheme. " " utilities, and process control operations. This language is"
"In addition to the the base Scheme language, " " defined in " ,(main-manual-page "mzscheme") ". ")
"PLT Scheme provides exceptions, threads, " (li ,(standout-text "Graphical (MrEd)") " includes the "
"objects, modules, components, regular expressions, " (standout-text "Textual (MzScheme)") " language and adds a"
"TCP support, filesystem utilities, and process " " graphical toolbox, described in "
"control operations. This language is defined in " ,(main-manual-page "mred") ".")
,(main-manual-page "mzscheme") (li ,(standout-text "Pretty Big") " is a superset of the "
". ") (standout-text "Graphical (MrEd)")
(LI " language, and adds forms from the "
,(standout-text "Graphical (MrEd)") (standout-text "Pretty Big") " language. For those forms that"
" includes the " (standout-text "Textual (MzScheme)") " language " " are in both languages, Pretty Big behaves like Graphical"
"and adds a graphical toolbox, " " (MrEd)."))
"described in " "The " (a ([name "module"] [value "module"]))
,(main-manual-page "mred") ".")
(LI ,(standout-text "Pretty Big")
" is a superset of the "
(standout-text "Graphical (MrEd)")
" language, and adds forms from the "
(standout-text "Pretty Big")
" language."
" For those forms that are in both languages,"
" Pretty Big behaves like Graphical (MrEd)."))
"The "
(A ([NAME "module"] [VALUE "module"]))
,(standout-text "module") ,(standout-text "module")
" language supports development using PLT Scheme's " " language supports development using PLT Scheme's "
,(manual-entry "mzscheme" "modules" `(CODE "module")) ,(manual-entry "mzscheme" "modules" `(code "module"))
" form, where the module's language is explicitly " " form, where the module's language is explicitly declared in the code."
"declared in the code." (p)
(P) "See " ,(manual-entry "drscheme" "language levels" "the DrScheme manual")
"See " " for further details on the languages, especially the teaching"
,(manual-entry "drscheme" "language levels" "the DrScheme manual") " languages."
" for further details on the languages, " (p)
"especially the teaching languages." "DrScheme's set of languages can be extended, so the above list"
(P) " mentions only the languages installed by default. Documentation for"
"DrScheme's set of languages can be extended, " " all languages is available through the "
"so the above list mentions only the languages installed " (a ([href "/servlets/manuals.ss"]) "manuals page") "."
"by default. " (p)
"Documentation for all languages is available " (a ([name "lang-sel"] [value "language, setting"]))
"through the " "DrScheme's default language is Beginning Student. To change the"
(A ([HREF "/servlets/manuals.ss"]) "manuals page") "." " language, select the " (b "Choose Language...") " item in the "
(P)
(A ([NAME "lang-sel"] [VALUE "language, setting"]))
"DrScheme's default language is Beginning Student. "
"To change the language, select the "
(B "Choose Language...")
" item in the "
(B "Language") " menu.")))) (B "Language") " menu."))))

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

@ -3,19 +3,15 @@
"../private/get-help-url.ss" "../private/get-help-url.ss"
"../private/manuals.ss" "../private/manuals.ss"
(lib "servlet.ss" "web-server")) (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)
(report-errors-to-browser send/finish) (report-errors-to-browser send/finish)
`(html `(html
(head (title "Teachpacks")) (head (title "Teachpacks"))
(BODY (body (h1 "Teachpacks")
(H1 "Teachpacks") (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\""))))))))