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
an hdindex file. See plt/collects/help/doc.txt for information about
the structure of such files.
When the doc/help subcollection is installed, the installer creates an
hdindex file. See plt/collects/help/doc.txt for information about the
structure of such files.
To create index entries for Help Desk servlets, put
anchor entries of the form
To create index entries for Help Desk servlets, put anchor entries of
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
can be any string that is unique among such anchors in that
file, though of course it should be mnemonic. The VALUE
attribute is used as the index entry that is matched against
search strings in Help Desk, and appears again as the
link caption in the Help Desk search results.
on a single line in the Scheme source. The `name' attribute can be
any string that is unique among such anchors in that file, though of
course it should be mnemonic. The `value' attribute is used as the
index entry that is matched against search strings in Help Desk, and
appears again as the 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")
(lib "servlet.ss" "web-server")
"private/util.ss")
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
`(HTML
(TITLE "Acknowledgements")
(BODY
(A ((NAME "acknowledgements") (VALUE "acknowledgements")))
(H1 "Acknowledgements")
(P)
,(get-general-acks)
(P)
,(get-translating-acks)))))
`(html (head (title "Acknowledgements"))
(body (a ([name "acknowledgements"] [value "acknowledgements"]))
(h1 "Acknowledgements")
(p)
,(get-general-acks)
(p)
,(get-translating-acks)))))

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

@ -1,17 +1,13 @@
(module doc-anchor mzscheme
(require "private/read-doc.ss")
(require (lib "servlet.ss" "web-server"))
(require "private/read-doc.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
(let* ([bindings (request-bindings initial-request)]
[offset (with-handlers
((void (lambda _ #f)))
[offset (with-handlers ((void (lambda _ #f)))
(string->number
(extract-binding/single 'offset bindings)))])
(read-doc (extract-binding/single 'file bindings)

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

@ -1,25 +1,19 @@
(module doc-content mzscheme
(require "private/headelts.ss")
(require "private/read-lines.ss")
(require (lib "servlet.ss" "web-server"))
(require "private/headelts.ss"
"private/read-lines.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
(let* ([bindings (request-bindings initial-request)]
[file (extract-binding/single 'file bindings)]
[caption (extract-binding/single 'caption bindings)]
[offset (with-handlers
((void (lambda _ #f)))
(string->number
[offset (with-handlers ((void (lambda _ #f)))
(string->number
(extract-binding/single 'offset bindings)))])
`(HTML
(HEAD (TITLE "PLT Help Desk")
,hd-css
,@hd-links)
,(read-lines file caption offset)))))
`(html (head (title "PLT Help Desk")
,hd-css
,@hd-links)
,(read-lines file caption offset)))))

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

@ -1,21 +1,14 @@
(module doc-message mzscheme
(require "private/headelts.ss"
"private/util.ss")
(require (lib "servlet.ss" "web-server"))
"private/util.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
(let ([bindings (request-bindings initial-request)])
`(HTML
(HEAD ,hd-css
,@hd-links
(TITLE "PLT collection message"))
(BODY
,(format-collection-message
(extract-binding/single 'msg bindings))
(HR))))))
`(html (head ,hd-css ,@hd-links (title "PLT collection message"))
(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)
(cond [(and (pair? item) (symbol? (car item))) 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)])
`(LI (B (A ([HREF ,url]) ,title)) ": " ,subtitle
`(li (b (a ([href ,url]) ,title)) ": " ,subtitle
,@(if (null? subs)
'()
`((BR) nbsp nbsp nbsp nbsp nbsp nbsp
(FONT ([SIZE "-2"])
,@(apply append
(map (lambda (s) `(,(item->xexpr s) ", ")) subs))
`((br) nbsp nbsp nbsp nbsp nbsp nbsp
(font ([size "-2"])
,@(apply append (map (lambda (s) `(,(item->xexpr s) ", "))
subs))
"...")))
(BR) (BR))))
(br) (br))))
(define (start initial-request)
(report-errors-to-browser send/finish)
@ -48,14 +48,14 @@
(head (title "PLT Help Desk"))
(body
(table ([cellspacing "0"] [cellpadding "0"])
(TR (TD (H1 "PLT Help Desk")
(UL ,@(map item items))
(P) nbsp nbsp nbsp
(B (A ((HREF "/servlets/acknowledge.ss"))
(FONT ([COLOR "forestgreen"]) "Acknowledgements")))
(tr (td (h1 "PLT Help Desk")
(ul ,@(map item items))
(p) nbsp nbsp nbsp
(b (a ((href "/servlets/acknowledge.ss"))
(font ([color "forestgreen"]) "Acknowledgements")))
nbsp nbsp nbsp nbsp
(B (A ((mzscheme
"((dynamic-require '(lib |bug-report.ss| |help|) 'help-desk:report-bug))"))
(FONT ([COLOR "forestgreen"]) "Send a bug report")))
(P)
(I "Version: " ,(plt-version)))))))))
(b (a ([mzscheme
"((dynamic-require '(lib |bug-report.ss| |help|) 'help-desk:report-bug))"])
(font ([color "forestgreen"]) "Send a bug report")))
(p)
(i "Version: " ,(plt-version)))))))))

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

@ -1,31 +1,27 @@
(module howtodrscheme mzscheme
(require "private/headelts.ss"
"../private/manuals.ss")
(require (lib "servlet.ss" "web-server"))
"../private/manuals.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
`(HTML
(TITLE "DrScheme")
(HEAD ,hd-css
,@hd-links)
(BODY
(H1 "DrScheme")
`(html
(head ,hd-css ,@hd-links (title "DrScheme"))
(body
(h1 "DrScheme")
"DrScheme is PLT's flagship programming environment. "
"See " (A ((HREF "/servlets/scheme/how.ss")) "Software & Components")
" for a guide to the full suite of PLT tools."
(UL
(LI (B (A ((HREF ,(get-manual-index "tour")))) "Tour") ": An introduction to DrScheme")
(LI (B ,(manual-entry "drscheme"
"graphical interface"
"Interface Essentials"))
": Quick-start jump into the user manual")
(LI (B (A ((HREF "/servlets/scheme/what.ss"))
"Languages"))
": Languages supported by DrScheme")
(LI (B ,(main-manual-page "drscheme")) ": The complete user manual"))))))
"See " (a ((href "/servlets/scheme/how.ss")) "Software & Components")
" for a guide to the full suite of PLT tools."
(ul (li (b (a ([href ,(get-manual-index "tour")])) "Tour")
": An introduction to DrScheme")
(li (b ,(manual-entry "drscheme"
"graphical interface"
"Interface Essentials"))
": Quick-start jump into the user manual")
(li (b (a ([href "/servlets/scheme/what.ss"])
"Languages"))
": Languages supported by DrScheme")
(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/manuals.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
`(HTML
(TITLE "Program Design")
(HEAD ,hd-css
,@hd-links)
(BODY
(H1 "Program Design")
,(color-highlight `(H2 "For Students"))
"The textbook " (I "How to Design Programs")
" provides an introduction to programming using the DrScheme environment. "
"The book is not distributed with DrScheme, but it is available online at "
(PRE
" " (A ((HREF "http://www.htdp.org/") (TARGET "_top"))
"http://www.htdp.org/"))
(P)
`(html
(head ,hd-css ,@hd-links (title "Program Design"))
(body
(h1 "Program Design")
,(color-highlight `(h2 "For Students"))
"The textbook " (i "How to Design Programs")
" provides an introduction to programming using the DrScheme"
" environment. The book is not distributed with DrScheme, but it"
" is available online at "
(pre " " (a ([href "http://www.htdp.org/"] [target "_top"])
"http://www.htdp.org/"))
(p)
"Help Desk provides the following interactive support for the textbook:"
(UL
(LI (B (A ((HREF "/servlets/teachpacks.ss")) "Teachpack documentation"))))
(P)
,(color-highlight
`(H2 "For Experienced Programmers"))
(UL (LI (B (A ((HREF ,(get-manual-index "t-y-scheme")))
"Teach Yourself Scheme in Fixnum Days"))
": For programmers with lots of experience in other languages"))
,(color-highlight `(H2 "For Teachers and Researchers"))
(UL (LI (B (A ((HREF "/servlets/research/why.ss")) "Why DrScheme?"))
": PLT's vision "))))))
(ul (li (b (a ([href "/servlets/teachpacks.ss"])
"Teachpack documentation"))))
(p)
,(color-highlight `(h2 "For Experienced Programmers"))
(ul (li (b (a ((href ,(get-manual-index "t-y-scheme")))
"Teach Yourself Scheme in Fixnum Days"))
": For programmers with lots of experience in other languages"))
,(color-highlight `(h2 "For Teachers and Researchers"))
(ul (li (b (a ([href "/servlets/research/why.ss"]) "Why DrScheme?"))
": PLT's vision "))))))

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

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

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

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

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

@ -1,34 +1,31 @@
(module manual-section mzscheme
(require "../private/manuals.ss"
"private/headelts.ss")
(require (lib "servlet.ss" "web-server"))
"private/headelts.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
(let* ([bindings (request-bindings initial-request)]
[manual (extract-binding/single 'manual bindings)]
[raw-section (extract-binding/single 'section bindings)]
; remove quotes
[section (substring raw-section
;; remove quotes
[section (substring raw-section
1 (sub1 (string-length raw-section)))]
[page (with-handlers
[page (with-handlers
([void (lambda _
(send/finish
`(HTML
(HEAD (TITLE "Can't find manual section")
,hd-css
,@hd-links)
(BODY
"Error looking up PLT manual section"
(P)
`(html
(head ,hd-css ,@hd-links
(title "Can't find manual section"))
(body
"Error looking up PLT manual section"
(p)
"Requested manual: "
,manual (BR)
,manual (br)
"Requested section: "
,section))))])
(finddoc-page-anchor manual section))])
(send/finish
(redirect-to page)))))
(send/finish (redirect-to page)))))

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

@ -1,13 +1,9 @@
(module manuals mzscheme
(require "../private/manuals.ss")
(require (lib "servlet.ss" "web-server"))
(require "../private/manuals.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
(list
#"text/html"
(find-manuals))))
(list #"text/html" (find-manuals))))

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

@ -1,51 +1,41 @@
(module missing-manual mzscheme
(require (lib "servlet.ss" "web-server"))
(require "private/headelts.ss")
(require "private/util.ss"
(require (lib "servlet.ss" "web-server")
"private/headelts.ss"
"private/util.ss"
"../private/standard-urls.ss")
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
(let ([bindings (request-bindings initial-request)])
(no-manual (extract-binding/single 'manual bindings)
(extract-binding/single 'name 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")
"."))))
(require (lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
(let ([bindings (request-bindings initial-request)])
(no-manual (extract-binding/single 'manual bindings)
(extract-binding/single 'name bindings)
(extract-binding/single 'link bindings)))))
(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
(provide exit-box)
(define exit-box (box #f)))

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

@ -1,38 +1,14 @@
(module external mzscheme
(require (lib "servlet.ss" "web-server")
(lib "defmacro.ss"))
(require "headelts.ss")
(provide external-box
check-external)
(require (lib "servlet.ss" "web-server") (lib "defmacro.ss") "headelts.ss")
(provide external-box check-external)
(define external-box (box #f))
(define (check-external show url)
(when (unbox external-box)
(show
`(HTML
(HEAD ,hd-css
,@hd-links
(TITLE "Servlet unavailable"))
(BODY
(H3
(FONT ((COLOR "red"))
"Servlet unavailable"))
(P)
"Because the PLT Help Desk server is "
"accepting external connections, the "
"requested Help Desk servlet"
(BLOCKQUOTE (TT ,url))
"is not available."))))))
`(html (head ,hd-css ,@hd-links (title "Servlet unavailable"))
(body (h3 (font ([color "red"]) "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
(require (lib "list.ss"))
(provide hd-css hd-links)
(provide hd-css
hd-links)
;; cascading style sheet rules for Help Desk
; cascading style sheet rules for Help Desk
; (listof (tag attrib+))
; where attrib is a property name, value pair
; where a value is a symbol or (listof symbol)
;; (listof (tag attrib+))
;; where attrib is a property name, value pair
;; where a value is a symbol or (listof symbol)
(define css-rules
'((BODY (background-color white)
(font-family (Helvetica sans-serif)))))
(define nl (string #\newline))
'([body (background-color white) (font-family (Helvetica sans-serif))]))
(define (css-rules->style)
(apply string-append
(map
(lambda (s) (string-append s nl))
(map
(lambda (rule)
(let ([tag (car rule)]
[attribs (cdr rule)])
(string-append
(symbol->string tag)
" {"
(foldr
(lambda (s a)
(if a (string-append s "; " a) s))
#f
(map
(lambda (attrib)
(let ([property (car attrib)]
[vals (cadr attrib)])
(string-append (symbol->string property) ":"
(if (pair? vals)
(foldr (lambda (s a)
(if a (string-append s "," a) s))
#f
(map symbol->string vals))
(symbol->string vals)))))
attribs))
"}")))
css-rules))))
(apply
string-append
(map (lambda (s) (string-append s "\n"))
(map (lambda (rule)
(let ([tag (car rule)]
[attribs (cdr rule)])
(string-append
(symbol->string tag)
" {"
(foldr
(lambda (s a) (if a (string-append s "; " a) s))
#f
(map
(lambda (attrib)
(let ([property (car attrib)]
[vals (cadr attrib)])
(string-append
(symbol->string property) ":"
(if (pair? vals)
(foldr (lambda (s a)
(if a (string-append s "," a) s))
#f
(map symbol->string vals))
(symbol->string vals)))))
attribs))
"}")))
css-rules))))
(define hd-css
`(STYLE ((TYPE "text/css")) ,(css-rules->style)))
; LINKs for showing PLT icon
`(style ([type "text/css"]) ,(css-rules->style)))
;; LINKs for showing PLT icon
(define hd-links
`((LINK ((REL "icon") (HREF "/help/servlets/plticon.ico") (TYPE "image/ico")))
(LINK ((REL "SHORTCUT ICON") (HREF "/help/servlets/plticon.ico"))))))
`((link ([rel "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")
(define name "Help Desk servlets private"))

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

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

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

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

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

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

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

@ -1,25 +1,18 @@
(module bugs mzscheme
(require (lib "string.ss"))
(require "../private/util.ss")
(require "../private/headelts.ss")
(require (lib "servlet.ss" "web-server"))
(require (lib "string.ss")
"../private/util.ss"
"../private/headelts.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(define stupid-internal-define-syntax (report-errors-to-browser send/finish))
`(HTML
(HEAD ,hd-css
,@hd-links
(TITLE "Known Bugs"))
(BODY
(H1 "Known Bugs in PLT Scheme")
(A ((NAME "bugs") (VALUE "Bugs")))
(report-errors-to-browser send/finish)
`(html
(head ,hd-css ,@hd-links (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 "
(A ((HREF "http://bugs.plt-scheme.org/query/")
(TARGET "_top")) "PLT bug report query page")) ".")))
(a ([href "http://bugs.plt-scheme.org/query/"] [target "_top"])
"PLT bug report query page")) ".")))

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

@ -2,34 +2,23 @@
(require "../private/util.ss"
"../private/headelts.ss"
(lib "uri-codec.ss" "net")
(lib "dirs.ss" "setup"))
(require (lib "servlet.ss" "web-server"))
(lib "dirs.ss" "setup")
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (make-item ss)
`(UL
(LI
,@(map (lambda (s)
`(DIV ,s (BR)))
ss))))
`(ul (li ,@(map (lambda (s) `(div ,s (br))) ss))))
(define copyright-year 2006)
(define (start initial-request)
(report-errors-to-browser send/finish)
`(HTML
(HEAD ,hd-css
,@hd-links
(TITLE "License"))
(BODY
(A ((NAME "lic") (VALUE "License")))
(B "PLT Software") (BR)
(B ,(format "Copyright (c) ~a PLT Scheme Inc." copyright-year))
(P)
`(html
(head ,hd-css ,@hd-links (title "License"))
(body
(a ([name "lic"] [value "License"]))
(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 "
" License (LGPL). This means you can link PLT software (such as "
"MzScheme or MrEd) into proprietary applications, provided you follow "
@ -37,63 +26,66 @@
"software; if you distribute a modified version, you must distribute it "
"under the terms of the LGPL, which in particular means that you must "
"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
(path->string
(simplify-path
(build-path (find-doc-dir) "release-notes" "COPYING.LIB")))))))
(simplify-path (build-path (find-doc-dir)
"release-notes"
"COPYING.LIB")))))])
"COPYING.LIB")
" for more information."
(P)
(p)
"PLT software includes or extends the following copyrighted material:"
(P)
,@(map make-item
`(("DrScheme"
"Copyright (c) 1995-2006 PLT"
,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year)
"All rights reserved.")
("MrEd"
"Copyright (c) 1995-2006 PLT"
,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year)
"All rights reserved.")
("MzScheme"
"Copyright (c) 1995-2006 PLT"
,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year)
"All rights reserved.")
("libscheme"
"Copyright (c) 1994 Brent Benson"
"All rights reserved.")
("wxWindows"
"Copyright (c) 1994 Artificial Intelligence Applications Institute, The University of Edinburgh"
"All rights reserved.")
("wxWindows Xt"
"Copyright (c) 1994 Artificial Intelligence Applications Institute, The University of Edinburgh"
"Copyright (c) 1995 GNU (Markus Holzem)"
"All rights reserved.")
("Conservative garbage collector"
"Copyright (c) 1988, 1989 Hans-J. Boehm, Alan J. Demers"
"Copyright (c) 1991-1996 Xerox Corporation"
"Copyright (c) 1996-1999 Silicon Graphics"
"Copyright (c) 1999-2001 by Hewlett-Packard Company"
"All rights reserved.")
("Collector C++ extension by Jesse Hull and John Ellis"
"Copyright (c) 1994 Xerox Corporation"
"All rights reserved.")
("The A List"
"Copyright (c) 1997-2000 Kyle Hammond."
"All rights reserved.")
("Independent JPEG Group library"
"Copyright (c) 1991-1998 Thomas G. Lane."
"All rights reserved.")
("libpng"
"Copyright (c) 2000-2002 Glenn Randers-Pehrson"
"All rights reserved.")
("zlib"
"Copyright (c) 1995-2002 Jean-loup Gailly and Mark Adler"
"All rights reserved.")
("GNU MP Library"
"Copyright (c) 1992, 1993, 1994, 1996 by Free Software Foundation, Inc.")
("GNU lightning"
"Copyright (c) 1994, 1995, 1996, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.")
("GNU Classpath"
"GNU Public License with special exception")))))))
(p)
,@(map
make-item
`(("DrScheme"
,(format "Copyright (c) 1995-~a PLT" copyright-year)
,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year)
"All rights reserved.")
("MrEd"
,(format "Copyright (c) 1995-~a PLT" copyright-year)
,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year)
"All rights reserved.")
("MzScheme"
,(format "Copyright (c) 1995-~a PLT" copyright-year)
,(format "Copyright (c) 2004-~a PLT Scheme Inc." copyright-year)
"All rights reserved.")
("libscheme"
"Copyright (c) 1994 Brent Benson"
"All rights reserved.")
("wxWindows"
"Copyright (c) 1994 Artificial Intelligence Applications Institute, The University of Edinburgh"
"All rights reserved.")
("wxWindows Xt"
"Copyright (c) 1994 Artificial Intelligence Applications Institute, The University of Edinburgh"
"Copyright (c) 1995 GNU (Markus Holzem)"
"All rights reserved.")
("Conservative garbage collector"
"Copyright (c) 1988, 1989 Hans-J. Boehm, Alan J. Demers"
"Copyright (c) 1991-1996 Xerox Corporation"
"Copyright (c) 1996-1999 Silicon Graphics"
"Copyright (c) 1999-2001 by Hewlett-Packard Company"
"All rights reserved.")
("Collector C++ extension by Jesse Hull and John Ellis"
"Copyright (c) 1994 Xerox Corporation"
"All rights reserved.")
("The A List"
"Copyright (c) 1997-2000 Kyle Hammond."
"All rights reserved.")
("Independent JPEG Group library"
"Copyright (c) 1991-1998 Thomas G. Lane."
"All rights reserved.")
("libpng"
"Copyright (c) 2000-2002 Glenn Randers-Pehrson"
"All rights reserved.")
("zlib"
"Copyright (c) 1995-2002 Jean-loup Gailly and Mark Adler"
"All rights reserved.")
("GNU MP Library"
"Copyright (c) 1992, 1993, 1994, 1996 by Free Software Foundation, Inc.")
("GNU lightning"
"Copyright (c) 1994, 1995, 1996, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.")
("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")
"../private/util.ss"
"../private/headelts.ss")
(define (make-entry s)
(let* ([label (car s)]
[dir (cadr s)]
[filename (caddr s)]
[file (build-path (find-doc-dir) "release-notes" dir filename)])
(if (file-exists? file)
`(LI (A ((HREF ,(format "/servlets/doc-anchor.ss?file=~a&name=~a&caption=~a"
(uri-encode (path->string file))
filename
label)))
,label))
#f)))
(require (lib "servlet.ss" "web-server"))
`(li (a ([href ,(format
"/servlets/doc-anchor.ss?file=~a&name=~a&caption=~a"
(uri-encode (path->string file))
filename
label)])
,label))
#f)))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
`(HTML
(HEAD ,hd-css
,@hd-links
(TITLE "PLT release notes"))
(H1 "Release Notes for PLT Scheme version " ,(version))
(A ((NAME "relnotes") (VALUE "Release notes")))
"Detailed release notes:"
(UL
,@(filter
(lambda (x) x) ; delete #f entries
(map make-entry
'(("DrScheme release notes"
"drscheme" "HISTORY")
("Teachpack release notes"
"teachpack" "HISTORY")
("MzScheme version 300 notes"
"mzscheme" "MzScheme_300.txt")
("MzScheme release notes"
"mzscheme" "HISTORY")
("MrEd release notes"
"mred" "HISTORY")
("Stepper release notes"
"stepper" "HISTORY")
("MrFlow release notes"
"mrflow" "HISTORY"))))))))
`(html
(head ,hd-css ,@hd-links (title "PLT release notes"))
(body
(h1 "Release Notes for PLT Scheme version " ,(version))
(a ([name "relnotes"] [VALUE "Release notes"]))
"Detailed release notes:"
(ul
,@(filter
values ; delete #f entries
(map make-entry
'(("DrScheme release notes" "drscheme" "HISTORY")
("Teachpack release notes" "teachpack" "HISTORY")
("MzScheme version 300 notes" "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
(require "../private/headelts.ss"
"../private/util.ss")
(require (lib "servlet.ss" "web-server"))
"../private/util.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
`(HTML
(HEAD ,hd-css
,@hd-links
(TITLE "Downloadable Patches"))
(H1 "Downloadable Patches")
(A ((NAME="patches") (VALUE "Downloadable patches")))
"The following Web page may contain downloadable patches to fix serious bugs in "
"version " ,(version) " of the PLT software:"
(P)
'nbsp 'nbsp
,(let ([url (format "http://download.plt-scheme.org/patches/~a/" (version))])
`(A ((HREF ,url)
(TARGET "_top")) ,url)))))
`(html
(head ,hd-css ,@hd-links (title "Downloadable Patches"))
(body
(h1 "Downloadable Patches")
(a ([name "patches"] [value "Downloadable patches"]))
"The following Web page may contain downloadable patches to fix "
"serious bugs in version " ,(version) " of the PLT software:"
(p)
nbsp nbsp
,(let ([url (format "http://download.plt-scheme.org/patches/~a/"
(version))])
`(a ([href ,url] [target "_top"]) ,url))))))

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

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

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

@ -1,67 +1,60 @@
(module why mzscheme
(require "../private/headelts.ss"
"../private/util.ss")
(require (lib "servlet.ss" "web-server"))
"../private/util.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
`(HTML
(HEAD ,hd-css
,@hd-links
(TITLE "Why DrScheme?"))
(BODY
(H1 "Why DrScheme?")
"Teaching introductory computing courses with Scheme, or any other "
"functional programming language, facilitates many conceptual tasks "
"and greatly enhances the appeal of computer science. Specifically, "
"students can implement many interesting programs with just a "
"small subset of the language. The execution of a functional program "
"can be explained with simple reduction rules that students mostly "
"know from secondary school. Interactive implementations allow "
"for quick feedback to the programmers andmake the development of "
"small functions a pleasant experience."
(P)
"Unfortunately, the poor quality of the available environments "
"for functional languages negates these advantages. Typical "
"implementations accept too many definitions, that is, definitions "
"that are syntactically well-formed in the sense of the full "
"language but meaningless for beginners. The results are "
"inexplicable behavior, incomprehensible run-time errors, or "
"confusing type error messages. The imperative nature of "
"read-eval-print loops often introduces subtle bugs into "
"otherwise perfect program developments. Scheme, in particular, "
"suffers from an adherence to Lisp's output traditions, which "
"often produces confusing effects. In many cases students, "
"especially those familiar with commercial C++ environments, "
"mistake these problems for problems with the functional "
"approach and reject the approach itself."
(P)
"To overcome this obstacle, we have developed a new programming "
"environment for Scheme. It fully integrates a (graphics-enriched) "
"editor, a multi-lingual parser that can process a hierarchy "
"of syntactically restrictive variants of Scheme, a functional "
"read-eval-print loop, and an algebraically sensible printer. "
"The environment catches the typical syntactic mistakes of "
"beginners and pinpoints the exact source location of run-time "
"exceptions. The new programming environment also provides "
"an algebraic stepper and a static debugger. The former reduces "
"Scheme programs, including programs with assignment and "
"control effects, to values (and effects). The static debugger "
"infers what set of values an expression may produce and how "
"values flow from expressions into variables. It exposes potential "
"safety violations and, upon demand from the programmer, explains "
"its reasoning by drawing value flowgraphs over the program text. "
"Preliminary experience with the environment shows that "
"students find it helpful and that they greatly prefer it to "
"shell-based or Emacs-based systems."
(P)
"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") "."))))
`(html
(head ,hd-css ,@hd-links (title "Why DrScheme?"))
(body
(h1 "Why DrScheme?")
"Teaching introductory computing courses with Scheme, or any other"
" functional programming language, facilitates many conceptual tasks"
" and greatly enhances the appeal of computer science. Specifically,"
" students can implement many interesting programs with just a small"
" subset of the language. The execution of a functional program can be"
" explained with simple reduction rules that students mostly know from"
" secondary school. Interactive implementations allow for quick"
" feedback to the programmers andmake the development of small"
" functions a pleasant experience."
(p)
"Unfortunately, the poor quality of the available environments for"
" functional languages negates these advantages. Typical"
" implementations accept too many definitions, that is, definitions"
" that are syntactically well-formed in the sense of the full language"
" but meaningless for beginners. The results are inexplicable behavior,"
" incomprehensible run-time errors, or confusing type error messages."
" The imperative nature of read-eval-print loops often introduces"
" subtle bugs into otherwise perfect program developments. Scheme, in"
" particular, suffers from an adherence to Lisp's output traditions,"
" which often produces confusing effects. In many cases students,"
" especially those familiar with commercial C++ environments, mistake"
" these problems for problems with the functional approach and reject"
" the approach itself."
(p)
"To overcome this obstacle, we have developed a new programming"
" environment for Scheme. It fully integrates a (graphics-enriched)"
" editor, a multi-lingual parser that can process a hierarchy of"
" syntactically restrictive variants of Scheme, a functional"
" read-eval-print loop, and an algebraically sensible printer. The"
" environment catches the typical syntactic mistakes of beginners and"
" pinpoints the exact source location of run-time exceptions. The new"
" programming environment also provides an algebraic stepper and a"
" static debugger. The former reduces Scheme programs, including"
" programs with assignment and control effects, to values (and"
" effects). The static debugger infers what set of values an"
" expression may produce and how values flow from expressions into"
" variables. It exposes potential safety violations and, upon demand"
" from the programmer, explains its reasoning by drawing value"
" flowgraphs over the program text. Preliminary experience with the"
" environment shows that students find it helpful and that they greatly"
" prefer it to shell-based or Emacs-based systems."
(p)
"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
(require "private/headelts.ss")
(require (lib "servlet.ss" "web-server"))
(require "private/headelts.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
`(HTML
(HEAD ,hd-css
,@hd-links
(TITLE "External Resources"))
(BODY
(H1 "External Resources")
(P)
`(html
(head ,hd-css ,@hd-links (title "External Resources"))
(body
(h1 "External Resources")
(p)
"DrScheme is created by "
(A ((HREF "http://www.plt-scheme.org/") (TARGET "_top")) "PLT")
" based at Northeastern University, the University of Utah, "
"Brown University, and the University of Chicago. "
"Here are some links related to our activities."
(P)
(UL
(LI (B (A ((HREF "resources/teachscheme.ss"))
"TeachScheme! Workshops"))
": Free summer program")
(LI (B (A ((HREF "resources/libext.ss"))
"Libraries"))
": From PLT and contributors")
(LI (B (A ((HREF "resources/maillist.ss"))
"Mailing Lists")) ": How to subscribe"))
(P)
(a ([href "http://www.plt-scheme.org/"] [target "_top"]) "PLT")
" based at Northeastern University, the University of Utah,"
" Brown University, and the University of Chicago."
" Here are some links related to our activities."
(p)
(ul (li (b (a ([href "resources/teachscheme.ss"])
"TeachScheme! Workshops"))
": Free summer program")
(li (b (a ([href "resources/libext.ss"]) "Libraries"))
": From PLT and contributors")
(li (b (a ([href "resources/maillist.ss"]) "Mailing Lists"))
": How to subscribe"))
(p)
"Also, the Schemers.org Web site provides links for "
"many Scheme resources, including books, implementations, "
"and libraries: " (A ((HREF "http://www.schemers.org/")
(TARGET "_top")) "http://www.schemers.org/") "."))))
"and libraries: "
(a ([href "http://www.schemers.org/"] [target "_top"])
"http://www.schemers.org/") "."))))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@ -1,60 +1,36 @@
(module misc mzscheme
(require (lib "servlet.ss" "web-server"))
(require "../private/headelts.ss"
(require (lib "servlet.ss" "web-server")
"../private/headelts.ss"
"../private/util.ss")
; (listof string string) -> xexpr
;; (listof string string) -> xexpr
(define (make-link-line url/txt)
(let ([url (car url/txt)]
[txt (cadr url/txt)])
`(LI () (B () (A ((HREF ,(string-append
"/servlets/scheme/misc/"
url))) ,txt)))))
`(li (b (a ([href ,(string-append "/servlets/scheme/misc/" url)])
,txt)))))
(define links
'(("standalone.ss"
"How to build a stand-alone executable")
("graphics.ss"
"How to write graphics programs")
("script.ss"
"How to write Unix shell scripts")
("batch.ss"
"How to write Windows batch files")
("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"))
'(("standalone.ss" "How to build a stand-alone executable")
("graphics.ss" "How to write graphics programs")
("script.ss" "How to write Unix shell scripts")
("batch.ss" "How to write Windows batch files")
("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")))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
`(HTML
(HEAD ,hd-css
,@hd-links
(TITLE "How to do things in Scheme"))
(BODY
(H1 "How to do things in Scheme")
(UL
,@(map make-link-line links))
(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"))
".")))
`(html (head ,hd-css ,@hd-links (TITLE "How to do things in Scheme"))
(body
(h1 "How to do things in Scheme")
(ul ,@(map make-link-line links))
(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)
(define interface-version 'v1)
(define timeout +inf.0)
(define (standout-text s)
(with-color "forestgreen" `(B ,s)))
(define (start initial-request)
(define stupid-internal-define-syntax
(report-errors-to-browser send/finish))
(define (standout-text s)
(with-color "forestgreen" `(B ,s)))
`(HTML
(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"]))
(report-errors-to-browser send/finish)
`(html
(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):"
(P)
(DL (DD "Scheme is a statically scoped and properly "
"tail-recursive dialect of the Lisp programming "
"language [...] designed to have an exceptionally "
"clear and simple semantics and few different ways "
"to form expressions. A wide variety of programming "
"paradigms, including imperative, functional, and "
"message passing styles, find convenient expression "
"in Scheme."))
(P)
"DrScheme supports many dialects of Scheme. "
"The following dialects are specifically designed for "
"teaching computer science. In DrScheme's "
(A ([HREF "/servlets/scheme/what.ss#lang-sel"])
(p)
(dl (dd "Scheme is a statically scoped and properly tail-recursive"
" dialect of the Lisp programming language [...] designed to"
" have an exceptionally clear and simple semantics and few"
" different ways to form expressions. A wide variety of"
" programming paradigms, including imperative, functional, and"
" message passing styles, find convenient expression in"
" Scheme."))
(p)
"DrScheme supports many dialects of Scheme. The following dialects are"
" specifically designed for teaching computer science. In DrScheme's "
(a ([href "/servlets/scheme/what.ss#lang-sel"])
"language selection menu")
", they are found under the heading " (B "How to Design Programs") "."
(UL
(LI
(A ([NAME "beg"] [VALUE "Beginning Student language"]))
,(standout-text "Beginning Student")
" is a pedagogical version of Scheme "
"that is tailored for beginning computer "
"science students.")
(LI
(A ([NAME "begla"] [VALUE "Beginning Student with List Abbreviations language"]))
,(standout-text "Beginning Student with List Abbreviations")
" extends Beginning Student with convenient "
"(but potentially confusing) ways to write lists, "
"including quasiquote.")
(LI
(A ([NAME "int"] [VALUE "Intermediate Student language"]))
,(standout-text "Intermediate Student")
" adds local bindings and higher-order functions.")
(LI
(A ([NAME "intlam"] [VALUE "Intermediate Student with Lambda language"]))
,(standout-text "Intermediate Student with Lambda")
" adds anonymous functions.")
(LI
(A ([NAME "adv"] [VALUE "Advanced Student language"]))
,(standout-text "Advanced Student")
" adds mutable state."))
", they are found under the heading " (b "How to Design Programs") "."
(ul (li (a ([name "beg"] [value "Beginning Student language"]))
,(standout-text "Beginning Student")
" is a pedagogical version of Scheme that is tailored for"
" beginning computer science students.")
(li (a ([name "begla"]
[value "Beginning Student with List Abbreviations language"]))
,(standout-text "Beginning Student with List Abbreviations")
" extends Beginning Student with convenient (but potentially"
" confusing) ways to write lists, including quasiquote.")
(li (a ([name "int"] [value "Intermediate Student language"]))
,(standout-text "Intermediate Student")
" adds local bindings and higher-order functions.")
(li (a ([name "intlam"]
[value "Intermediate Student with Lambda language"]))
,(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 "
,(standout-text "Essentials of Programming Languages")
" language is designed for use with the MIT Press "
"textbook with that name."
(P)
"Other dialects are designed for practicing programmers. "
"The " (A ([NAME "r5rs2"] [VALUE "R5RS Scheme language"]))
" language is designed for use with the MIT Press textbook with that"
" name."
(p)
"Other dialects are designed for practicing programmers. The "
(a ([name "r5rs2"] [value "R5RS Scheme language"]))
,(standout-text "R5RS")
" language is a standard dialect of Scheme that is "
"defined by the "
" language is a standard dialect of Scheme that is defined by the "
,(main-manual-page "r5rs") ". "
(A ([NAME "full"] [VALUE "PLT Scheme language"]))
(a ([name "full"] [value "PLT Scheme language"]))
"In DrScheme's "
(A ([HREF "/servlets/scheme/what.ss#lang-sel"])
(a ([href "/servlets/scheme/what.ss#lang-sel"])
"language selection menu")
", the following languages "
"are found under the heading " (B "PLT") ":"
(UL
(LI
,(standout-text "Textual (MzScheme)")
" is a superset of R5RS Scheme. "
"In addition to the the base Scheme language, "
"PLT Scheme provides exceptions, threads, "
"objects, modules, components, regular expressions, "
"TCP support, filesystem utilities, and process "
"control operations. This language is defined in "
,(main-manual-page "mzscheme")
". ")
(LI
,(standout-text "Graphical (MrEd)")
" includes the " (standout-text "Textual (MzScheme)") " language "
"and adds a graphical toolbox, "
"described in "
,(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"]))
", the following languages are found under the heading " (b "PLT") ":"
(ul (li ,(standout-text "Textual (MzScheme)") " is a superset of R5RS"
" Scheme. In addition to the the base Scheme language, PLT"
" Scheme provides exceptions, threads, objects, modules,"
" components, regular expressions, TCP support, filesystem"
" utilities, and process control operations. This language is"
" defined in " ,(main-manual-page "mzscheme") ". ")
(li ,(standout-text "Graphical (MrEd)") " includes the "
(standout-text "Textual (MzScheme)") " language and adds a"
" graphical toolbox, described in "
,(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")
" language supports development using PLT Scheme's "
,(manual-entry "mzscheme" "modules" `(CODE "module"))
" form, where the module's language is explicitly "
"declared in the code."
(P)
"See "
,(manual-entry "drscheme" "language levels" "the DrScheme manual")
" for further details on the languages, "
"especially the teaching languages."
(P)
"DrScheme's set of languages can be extended, "
"so the above list mentions only the languages installed "
"by default. "
"Documentation for all languages is available "
"through the "
(A ([HREF "/servlets/manuals.ss"]) "manuals page") "."
(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 "
,(manual-entry "mzscheme" "modules" `(code "module"))
" form, where the module's language is explicitly declared in the code."
(p)
"See " ,(manual-entry "drscheme" "language levels" "the DrScheme manual")
" for further details on the languages, especially the teaching"
" languages."
(p)
"DrScheme's set of languages can be extended, so the above list"
" mentions only the languages installed by default. Documentation for"
" all languages is available through the "
(a ([href "/servlets/manuals.ss"]) "manuals page") "."
(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."))))

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

@ -3,19 +3,15 @@
"../private/get-help-url.ss"
"../private/manuals.ss"
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(report-errors-to-browser send/finish)
`(html
(head (title "Teachpacks"))
(BODY
(H1 "Teachpacks")
(UL (LI (B (A ((HREF ,(get-manual-index "teachpack")))
"Teachpacks for \"How to Design Programs\"")))
(LI (B (A ((HREF ,(get-manual-index "teachpack-htdc")))
"Teachpacks for \"How to Design Classes\""))))))))
(body (h1 "Teachpacks")
(ul (li (b (a ([href ,(get-manual-index "teachpack")])
"Teachpacks for \"How to Design Programs\"")))
(li (b (a ([href ,(get-manual-index "teachpack-htdc")])
"Teachpacks for \"How to Design Classes\""))))))))