diff --git a/collects/help/servlets/README b/collects/help/servlets/README
index d29ac10c07..640fd6e140 100644
--- a/collects/help/servlets/README
+++ b/collects/help/servlets/README
@@ -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.
diff --git a/collects/help/servlets/acknowledge.ss b/collects/help/servlets/acknowledge.ss
index 4fd0129477..ca24b6bc52 100644
--- a/collects/help/servlets/acknowledge.ss
+++ b/collects/help/servlets/acknowledge.ss
@@ -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)))))
diff --git a/collects/help/servlets/doc-anchor.ss b/collects/help/servlets/doc-anchor.ss
index 8a9deefbf4..7344c7f194 100644
--- a/collects/help/servlets/doc-anchor.ss
+++ b/collects/help/servlets/doc-anchor.ss
@@ -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)
diff --git a/collects/help/servlets/doc-content.ss b/collects/help/servlets/doc-content.ss
index ce62e69f13..36f53ff8bc 100644
--- a/collects/help/servlets/doc-content.ss
+++ b/collects/help/servlets/doc-content.ss
@@ -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)))))
\ No newline at end of file
+ `(html (head (title "PLT Help Desk")
+ ,hd-css
+ ,@hd-links)
+ ,(read-lines file caption offset)))))
diff --git a/collects/help/servlets/doc-message.ss b/collects/help/servlets/doc-message.ss
index e8fb6346f8..9267310908 100644
--- a/collects/help/servlets/doc-message.ss
+++ b/collects/help/servlets/doc-message.ss
@@ -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))))))
\ No newline at end of file
+ `(html (head ,hd-css ,@hd-links (title "PLT collection message"))
+ (body ,(format-collection-message
+ (extract-binding/single 'msg bindings))
+ (hr))))))
diff --git a/collects/help/servlets/home.ss b/collects/help/servlets/home.ss
index daa3ad19b2..bcb559f518 100644
--- a/collects/help/servlets/home.ss
+++ b/collects/help/servlets/home.ss
@@ -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)))))))))
diff --git a/collects/help/servlets/howtodrscheme.ss b/collects/help/servlets/howtodrscheme.ss
index 87efdd4ad0..a43110486a 100644
--- a/collects/help/servlets/howtodrscheme.ss
+++ b/collects/help/servlets/howtodrscheme.ss
@@ -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"))))))
\ No newline at end of file
+ "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"))))))
diff --git a/collects/help/servlets/howtoprogram.ss b/collects/help/servlets/howtoprogram.ss
index a364465cb4..92b4f61fe8 100644
--- a/collects/help/servlets/howtoprogram.ss
+++ b/collects/help/servlets/howtoprogram.ss
@@ -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 "))))))
diff --git a/collects/help/servlets/howtoscheme.ss b/collects/help/servlets/howtoscheme.ss
index f66969953d..98bfa74dd9 100644
--- a/collects/help/servlets/howtoscheme.ss
+++ b/collects/help/servlets/howtoscheme.ss
@@ -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"))))))
diff --git a/collects/help/servlets/howtouse.ss b/collects/help/servlets/howtouse.ss
index b5b1cc3b8f..37c4387ed4 100644
--- a/collects/help/servlets/howtouse.ss
+++ b/collects/help/servlets/howtouse.ss
@@ -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."))))
\ No newline at end of file
+ (b "Language")
+ " menu to change the language."))))
diff --git a/collects/help/servlets/manual-section.ss b/collects/help/servlets/manual-section.ss
index f90eebd0a5..3240bcc26b 100644
--- a/collects/help/servlets/manual-section.ss
+++ b/collects/help/servlets/manual-section.ss
@@ -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)))))
\ No newline at end of file
+ (send/finish (redirect-to page)))))
diff --git a/collects/help/servlets/manuals.ss b/collects/help/servlets/manuals.ss
index c3a37cc186..6d5db4e811 100644
--- a/collects/help/servlets/manuals.ss
+++ b/collects/help/servlets/manuals.ss
@@ -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))))
\ No newline at end of file
+ (list #"text/html" (find-manuals))))
diff --git a/collects/help/servlets/missing-manual.ss b/collects/help/servlets/missing-manual.ss
index 80aaf17d6c..07caf8ca0a 100644
--- a/collects/help/servlets/missing-manual.ss
+++ b/collects/help/servlets/missing-manual.ss
@@ -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")
+ ".")))))
diff --git a/collects/help/servlets/private/exit.ss b/collects/help/servlets/private/exit.ss
index f87bfab857..36b05114c4 100644
--- a/collects/help/servlets/private/exit.ss
+++ b/collects/help/servlets/private/exit.ss
@@ -1,4 +1,3 @@
(module exit mzscheme
(provide exit-box)
(define exit-box (box #f)))
-
diff --git a/collects/help/servlets/private/external.ss b/collects/help/servlets/private/external.ss
index cc3e49d8f8..01e7ff7a02 100644
--- a/collects/help/servlets/private/external.ss
+++ b/collects/help/servlets/private/external.ss
@@ -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."))))))
diff --git a/collects/help/servlets/private/headelts.ss b/collects/help/servlets/private/headelts.ss
index dfedfbe6c6..4c3d98cdb9 100644
--- a/collects/help/servlets/private/headelts.ss
+++ b/collects/help/servlets/private/headelts.ss
@@ -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"])))))
diff --git a/collects/help/servlets/private/info.ss b/collects/help/servlets/private/info.ss
index 592c4e457d..ae293fecee 100644
--- a/collects/help/servlets/private/info.ss
+++ b/collects/help/servlets/private/info.ss
@@ -1,11 +1,2 @@
(module info (lib "infotab.ss" "setup")
(define name "Help Desk servlets private"))
-
-
-
-
-
-
-
-
-
diff --git a/collects/help/servlets/private/read-doc.ss b/collects/help/servlets/private/read-doc.ss
index 52530dfdbf..98cfc64cad 100644
--- a/collects/help/servlets/private/read-doc.ss
+++ b/collects/help/servlets/private/read-doc.ss
@@ -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))))
diff --git a/collects/help/servlets/private/read-lines.ss b/collects/help/servlets/private/read-lines.ss
index 0850a45f60..3b4ada8dad 100644
--- a/collects/help/servlets/private/read-lines.ss
+++ b/collects/help/servlets/private/read-lines.ss
@@ -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
's instead of newlines, for Opera
- ; don't put in a
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
's instead of newlines, for Opera don't put in a
+ ;; 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)))))
diff --git a/collects/help/servlets/private/search-util.ss b/collects/help/servlets/private/search-util.ss
index bbebd91630..b8df32e05c 100644
--- a/collects/help/servlets/private/search-util.ss
+++ b/collects/help/servlets/private/search-util.ss
@@ -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")
diff --git a/collects/help/servlets/private/util.ss b/collects/help/servlets/private/util.ss
index 8ac0e96675..509d829a0c 100644
--- a/collects/help/servlets/private/util.ss
+++ b/collects/help/servlets/private/util.ss
@@ -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
diff --git a/collects/help/servlets/release/bugs.ss b/collects/help/servlets/release/bugs.ss
index e9532f5ae1..3285db357b 100644
--- a/collects/help/servlets/release/bugs.ss
+++ b/collects/help/servlets/release/bugs.ss
@@ -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")) ".")))
\ No newline at end of file
+ (a ([href "http://bugs.plt-scheme.org/query/"] [target "_top"])
+ "PLT bug report query page")) ".")))
diff --git a/collects/help/servlets/release/license.ss b/collects/help/servlets/release/license.ss
index f4f8bb4552..672d71eeb5 100644
--- a/collects/help/servlets/release/license.ss
+++ b/collects/help/servlets/release/license.ss
@@ -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")))))))
diff --git a/collects/help/servlets/release/notes.ss b/collects/help/servlets/release/notes.ss
index 3877701ad2..f8c8ca7e56 100644
--- a/collects/help/servlets/release/notes.ss
+++ b/collects/help/servlets/release/notes.ss
@@ -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")))))))))
diff --git a/collects/help/servlets/release/patches.ss b/collects/help/servlets/release/patches.ss
index 1243d66bc4..42b6ddb130 100644
--- a/collects/help/servlets/release/patches.ss
+++ b/collects/help/servlets/release/patches.ss
@@ -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)))))
\ No newline at end of file
+ `(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))))))
diff --git a/collects/help/servlets/releaseinfo.ss b/collects/help/servlets/releaseinfo.ss
index cae805515b..eb641ee305 100644
--- a/collects/help/servlets/releaseinfo.ss
+++ b/collects/help/servlets/releaseinfo.ss
@@ -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)))))))
\ No newline at end of file
+ `(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)))))))
diff --git a/collects/help/servlets/research/why.ss b/collects/help/servlets/research/why.ss
index 733a37bc66..cbc98cd590 100644
--- a/collects/help/servlets/research/why.ss
+++ b/collects/help/servlets/research/why.ss
@@ -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") "."))))
\ No newline at end of file
+ `(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") "."))))
diff --git a/collects/help/servlets/resources.ss b/collects/help/servlets/resources.ss
index 7f50ad9b89..e1ede38993 100644
--- a/collects/help/servlets/resources.ss
+++ b/collects/help/servlets/resources.ss
@@ -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/") "."))))
\ No newline at end of file
+ "and libraries: "
+ (a ([href "http://www.schemers.org/"] [target "_top"])
+ "http://www.schemers.org/") "."))))
diff --git a/collects/help/servlets/resources/libext.ss b/collects/help/servlets/resources/libext.ss
index cba8643656..952ab6a763 100644
--- a/collects/help/servlets/resources/libext.ss
+++ b/collects/help/servlets/resources/libext.ss
@@ -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!"))))
\ No newline at end of file
+ "Thanks for your efforts!"))))
diff --git a/collects/help/servlets/resources/maillist.ss b/collects/help/servlets/resources/maillist.ss
index 6cfde9d259..d923861c32 100644
--- a/collects/help/servlets/resources/maillist.ss
+++ b/collects/help/servlets/resources/maillist.ss
@@ -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."))))
diff --git a/collects/help/servlets/resources/teachscheme.ss b/collects/help/servlets/resources/teachscheme.ss
index 74617bd164..305be60f48 100644
--- a/collects/help/servlets/resources/teachscheme.ss
+++ b/collects/help/servlets/resources/teachscheme.ss
@@ -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") "."))))
\ No newline at end of file
+ (p)
+ "For more information, see the "
+ (a ([href "http://www.teach-scheme.org/Workshops/"]
+ [TARGET "_top"])
+ "TeachScheme! Workshops page") "."))))
diff --git a/collects/help/servlets/results.ss b/collects/help/servlets/results.ss
index b6cf4e8557..6b7a336305 100644
--- a/collects/help/servlets/results.ss
+++ b/collects/help/servlets/results.ss
@@ -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)))])))))
diff --git a/collects/help/servlets/scheme/doc.ss b/collects/help/servlets/scheme/doc.ss
index 5848a2bcbf..87c401407e 100644
--- a/collects/help/servlets/scheme/doc.ss
+++ b/collects/help/servlets/scheme/doc.ss
@@ -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."))))
\ No newline at end of file
+ (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."))))
diff --git a/collects/help/servlets/scheme/how.ss b/collects/help/servlets/scheme/how.ss
index 75e847f613..8459736c37 100644
--- a/collects/help/servlets/scheme/how.ss
+++ b/collects/help/servlets/scheme/how.ss
@@ -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)))
\ No newline at end of file
+ (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)))))))
diff --git a/collects/help/servlets/scheme/langlevels.ss b/collects/help/servlets/scheme/langlevels.ss
index a029967dfe..2d324bae81 100644
--- a/collects/help/servlets/scheme/langlevels.ss
+++ b/collects/help/servlets/scheme/langlevels.ss
@@ -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") "."))))
\ No newline at end of file
+ " 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")
+ "."))))
diff --git a/collects/help/servlets/scheme/misc.ss b/collects/help/servlets/scheme/misc.ss
index ba2107382d..44bae978be 100644
--- a/collects/help/servlets/scheme/misc.ss
+++ b/collects/help/servlets/scheme/misc.ss
@@ -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"))
- ".")))
\ No newline at end of file
+ `(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"))
+ "."))))
diff --git a/collects/help/servlets/scheme/what.ss b/collects/help/servlets/scheme/what.ss
index 9daaacd0be..25740d2ab4 100644
--- a/collects/help/servlets/scheme/what.ss
+++ b/collects/help/servlets/scheme/what.ss
@@ -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."))))
diff --git a/collects/help/servlets/teachpacks.ss b/collects/help/servlets/teachpacks.ss
index 6aaaaebd24..5bcd370961 100644
--- a/collects/help/servlets/teachpacks.ss
+++ b/collects/help/servlets/teachpacks.ss
@@ -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\""))))))))