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

removed a bunch of junk

Browse Source 
svn: r7774
This commit is contained in:
Robby Findler 2007-11-20 00:11:52 +00:00
parent 1c61b75f18
commit 22575dd28a
32 changed files with 0 additions and 2807 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,19 +0,0 @@
(module doc-anchor mzscheme
(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)
(with-errors-to-browser
send/finish
(lambda ()
(let* ([bindings (request-bindings initial-request)]
[offset (with-handlers ((void (lambda _ #f)))
(string->number
(extract-binding/single 'offset bindings)))])
(read-doc initial-request
(extract-binding/single 'file bindings)
(extract-binding/single 'caption bindings)
(extract-binding/single 'name bindings)
offset))))))

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

@ -1,19 +0,0 @@
(module doc-content mzscheme
(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)
(with-errors-to-browser
send/finish
(lambda ()
(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
(extract-binding/single 'offset bindings)))])
`(html (head (title "PLT Help Desk") ,hd-css ,@hd-links)
,(read-lines initial-request file caption offset)))))))

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

@ -1,16 +0,0 @@
(module doc-message mzscheme
(require "private/headelts.ss"
"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)
(with-errors-to-browser
send/finish
(lambda ()
(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))))))))

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

@ -1,848 +0,0 @@
(module home mzscheme
(require (lib "servlet.ss" "web-server")
(lib "match.ss")
(lib "acks.ss" "drscheme")
(lib "uri-codec.ss" "net")
(lib "dirs.ss" "setup")
(lib "list.ss")
(lib "url.ss" "net")
"../private/manuals.ss"
"private/util.ss" ; for plt-version
"private/url.ss"
"private/html.ss"
"private/split-screen.ss"
"../private/options.ss")
(define copyright-year 2007)
(provide interface-version timeout start
generate-index-for-static-pages)
(define interface-version 'v1)
(define timeout +inf.0)
;; html-subpage : xexprs -> xexpr
(define (html-subpage . xs)
(apply (case (helpdesk-platform)
[(internal-browser-simple) make-simple-page/internal-browser]
[(internal-browser) make-split-page/internal-browser]
[else make-split-page])
xs))
(define (start initial-request)
;; Note : DrScheme preferences calls start with a #f argument,
;; so initial-request can be either a request structure or #f
(unless initial-request
(set! initial-request
(make-request 'get (string->url "") '() '() #f "localhost"
(internal-port) "localhost")))
(with-errors-to-browser
send/finish
(lambda ()
(let* ([bindings (request-bindings initial-request)]
[subpage (if (exists-binding? 'subpage bindings)
(extract-binding/single 'subpage bindings)
"home")])
;; dispatch on subpage
;; the dynamic ones (manuals and release) are handled are here,
;; the static pages below
(match subpage
["manuals"
(html-subpage
"PLT Scheme Help Desk: Installed Manuals"
(html-top initial-request) (left-items) ""
`(,@(if (eq? (helpdesk-platform) 'external-browser)
'((h3 "NOTE")
(p "To see the list of manuals installed on " (i "your") " computer,"
" use the Help Desk from within DrScheme. This list of manuals reflects"
" what is installed on this Help Desk server only."))
'())
(VERBATIM ,(find-manuals))
(p (i "Version: " ,(plt-version)))))]
["release"
(let ([link-stuff (lambda (url txt)
`(li (b (a ([href ,url]) ,txt))))])
(html-subpage
"PLT Scheme Help Desk: Release Info"
(html-top initial-request) (left-items) ""
`((VERBATIM
((h3 "NOTE")
(p "To see the release information for your installation,"
" use the Help Desk from within DrScheme."
" The following information reflects the installation on"
" this server only.")
(h1 "Release Information")
(p (i "Version: " ,(plt-version)))
(ul ,(link-stuff url-helpdesk-license "License")
,(link-stuff url-helpdesk-release-notes "Release Notes")
,(link-stuff url-helpdesk-known-bugs "Known Bugs")
,(link-stuff url-helpdesk-patches "Downloadable Patches"))
(p "The PLT software is installed on this machine at" (br)
(pre nbsp nbsp ,(path->string (find-collects-dir)))))))))]
[_
(let-values ([(right-header right-items)
(page-tag->title+items subpage)])
(cond
[(and (eq? (helpdesk-platform) 'internal-browser-simple)
(equal? subpage "home"))
;; change the "home" page for internal HelpDesk with no menus
(html-subpage "PLT Scheme Help Desk: Home"
(html-top initial-request)
"home"
right-header
(append (left-items)
`(((p (i "Version: " ,(plt-version)))))))]
[else
(html-subpage "PLT Scheme Help Desk: Home"
(html-top initial-request)
(left-items)
right-header right-items)]))])))))
(define (left-items)
`(-- -- -- -- --
("Get help: "
nbsp nbsp nbsp nbsp
(b (a ((href ,url-helpdesk-help)) "Help Desk"))
,@(br*))
-- --
("Learn to program in Scheme: "
nbsp nbsp nbsp nbsp
"Reference: "
'nbsp
(a ((href ,url-helpdesk-manuals)) "Manuals") ", "
(a ((href ,url-helpdesk-libraries)) "Libraries")
(br) nbsp nbsp nbsp nbsp
(b (a ((href ,url-helpdesk-program-design)) "Program Design: "))
'nbsp
(a ((href ,url-helpdesk-books)) "Books") ", "
(a ((href ,url-helpdesk-languages)) "Languages") ", "
(a ((href ,url-helpdesk-teachpacks)) "Teachpacks")
,@(br*))
-- --
("How to run programs: "
nbsp nbsp nbsp nbsp (b (a ((href ,url-helpdesk-software)) "Software: "))
'nbsp
(a ((href ,url-helpdesk-tour)) "Tour") ", "
(a ((href ,url-helpdesk-drscheme)) "DrScheme") ", "
(a ((href ,url-helpdesk-release)) "Release")
,@(br*)
;; (a ((href ,url-helpdesk-drscheme-faq)) "FAQ") ; Moved to DrScheme page
)
-- --
("Get involved:"
nbsp nbsp nbsp nbsp
(a ((href ,url-helpdesk-mailing-lists)) "Mailing Lists")
,@(case (helpdesk-platform)
[(external-browser)
`(", " (a ((href ,url-external-send-bug-report)) "Send a bug report"))]
[else '()])
,@(br*))
-- --
(""
" " " "
,@(case (helpdesk-platform)
[(internal-browser internal-browser-simple)
'((b (a ([mzscheme
"((dynamic-require '(lib |bug-report.ss| |help|) 'help-desk:report-bug))"])
(font ([color "forestgreen"]) "Send a bug report")))
nbsp nbsp)]
[else `()])
;; DrScheme Acknowledgements
,@(case (helpdesk-platform)
[(internal-browser internal-browser-simple)
`((b (a ((href ,url-helpdesk-acknowledge))
(font ([color "forestgreen"])"Acknowledgments"))))]
[else '()]))
-- -- -- --))
;; page-tag->title+items : string -> (values string list-of-right-items)
(define (page-tag->title+items page-tag)
(match (assoc page-tag easy-pages)
[#f (page-tag->title+items "home")]
[(tag header body) (values header body)]))
;; generate-index-for-static-pages : -> list-of-index-entries
; used by install.ss to generate hdindex
(define (generate-index-for-static-pages)
; (<indexed-item> <url> <label-within-html-file> <page-title>)
(map (match-lambda
[(subpage page-title . more)
(let ([url (format "/servlets/home.ss?subpage=~a" subpage)])
`(,page-title ,url "" ,page-title))])
easy-pages))
;; static subpages
;; - In ALPHABETICAL order
(define easy-pages
`(("about-the-master-index" "About the Master Index"
((p "The master index is a list of all keywords present in the html documentation.")
(p (a ([href ,url-helpdesk-master-index]) "The Master Index"))))
;;
("acknowledge" "Acknowledgements"
((p ,(get-general-acks))
(p ,(get-translating-acks))))
;;
("activex" "How to use ActiveX components"
((p ; (a ([name "com"] [value "COM"]))
;(a ([name "activex"] [value "ActiveX"]))
"If you run Windows, you can use MysterX, a library for "
"controlling COM and ActiveX components within DrScheme, "
"MzScheme, or MrEd. MysterX is available from ")
(pre
nbsp nbsp
(a ([href "http://www.plt-scheme.org/software/mysterx/"])
"http://www.plt-scheme.org/software/mysterx/"))
#;(p ,(collection-doc-link "mysterx" "The MysterX collection"))))
;;
("batch" "How to write Windows batch files"
((p "You can put MzScheme code in a Windows batch file, that is, a "
"file with a .BAT extension. Batch files can be executed "
"directly from the command line. In Windows 95, 98, and Me, "
"the batch file looks like:"
(pre
" ; @echo off" (br)
" ; d:\\plt\\mzscheme -r %0 %1 %2 %3 %4 %5 %6 %7 %8 %9" (br)
" ; goto :end" (br)
" ... " (i "scheme-program") " ..." (br)
" ; :end")
"With this code, your batch file can use as many as nine "
"parameters.")
(p "In Windows NT, Windows 2000, and Windows XP, you can instead write "
(pre
" ; @echo off" (br)
" ; d:\\plt\\mzscheme -r %0 %*" (br)
" ; goto :end" (br)
" ... " (i "scheme-program") " ..." (br)
" ; :end")
"This code allows an arbitrary number of parameters to your "
"batch file.")
(p "The batch file code works by combining both batch and MzScheme "
"syntax in a single file. When invoked from the command line, "
"the semicolons are ignored. The second line invokes MzScheme "
"with the batch file as an argument. MzScheme interprets the "
"lines beginning with semicolons as comments, and runs the "
"Scheme code. When the Scheme program is "
"done, control returns to the batch file, and the "
(tt "goto") " jumps around the Scheme code.")))
;;
("books" "Books"
((h3 "HTDP - How to Design Programs")
(p (a ([href "http://www.htdp.org/"]) "'How to Design Programs -"
" An Introduction to Programming and Computing'")
(br) " by Matthias Felleisen, Robert Bruce Findler, Matthew Flatt, and Shriram Krishnamurthi")
(p (a ([href "http://www.ccs.neu.edu/home/matthias/htdp-plus.html"]) "HTDP+")
(br) " Supplemental Materials for 'How to Design Programs'")
(h3 "Teach Yourself Scheme in Fixnum Days")
(p (a ((href, url-helpdesk-teach-yourself)) " Teach Yourself Scheme in Fixnum Days")
(br) "- an introduction to Scheme by Dorai Sitaram")))
;;
("cgi" "How to write CGI scripts"
((p "Type " (tt "CGI") " in the " (b "Search for") " "
"field in Help Desk and click on the "
(b (tt "Search")) " button to get information "
"on CGI-related functions.")
(p "A CGI script is merely a program with funny inputs and "
"outputs. Input comes either from an environment variable "
"or through the standard input port, in a special format. "
"Output consists of a MIME header followed by the content. "
"Everything in-between is pure program.")
(p "MzScheme comes with a CGI library that is designed to "
"make it easy to write such scripts. In the mini-tutorial "
"below, we'll walk you through the "
"construction of such a script. If you have questions or "
"comments, send email to "
(a ((href "mailto:sk@plt-scheme.org")) "sk@plt-scheme.org") ".")
(hr)
(p "Let's write a simple \"finger server\" in MzScheme. "
"The front-end will be a Web form that accepts a username. "
"The form should supply a username in the field `name'. "
"The CGI script fingers that user.")
(p "First, make sure you have MzScheme installed on the host "
"where your Web server is located.")
(p "A CGI script must be an executable. Each OS has different "
"ways of launching an application. Under Unix, it's "
"probably easiest to make them simple shell scripts. "
"Therefore, place the following magic incantation at the "
"top of your script:")
(p (pre " #!/bin/sh" (br)
" string=? ; exec /usr/local/bin/mzscheme -r $0 \"$@\""))
(p "Make sure the path to MzScheme is specified correctly.")
(p "Now we're in Scheme-land. First, let's load the Scheme "
"CGI library and define where `finger' resides.")
(p (pre " (require (lib \"cgi.ss\" \"net\"))" (br)
" (define finger-program \"/usr/bin/finger\")"))
(p "Next we must get the names bound by the form, and "
"extract the username field.")
(p (pre " (let ((bindings (get-bindings)))" (br)
" (let ((name (extract-binding/single 'name bindings)))"))
(p "We use extract-binding/single to make sure only one name "
"field was bound. (You can bind the same field multiple "
"times using check-boxes. This is just one kind of "
"error-checking; a robust CGI script will do more.")
(p "Next we invoke the finger program using `process*'. "
"If no username was specified, we just run finger on the host.")
(p (pre " (let ((results (if (string=? name \"\"))" (br)
" (process* finger-program)" (br)
" (process* finger-program name))))"))
(p "The `process*' function returns a list of several values. "
"The first of these is the output port. Let's pull this "
"out and name it.")
(p (pre " (let ((proc->self (car results)))"))
(p "Now we extract the output of running finger into a "
"list of strings.")
(p (pre " (let ((strings (let loop " (br)
" (let ((l (read-line proc->self)))" (br)
" (if (eof-object? l)" (br)
" null" (br)
" (cons l (loop))))))))"))
(p "All that's left is to print this out to the user. "
"We use the `generate-html-output' procedure to do that, "
"which takes care of generating the appropriate MIME header "
"(as required of CGI scripts). "
"Note that the <pre> tag of HTML doesn't prevent its "
"contents from being processed. To avoid this "
"(i.e., to generate truly verbatim output), "
"we use `string->html', which knows about HTML quoting "
"conventions.")
(p (pre " (generate-html-output \"Finger Gateway Output\"" (br)
" (append " (br)
" '(\"<pre>\")" (br)
" (map string->html strings)" (br)
" '(\"</pre>\"))))))))"))
(p "That's all! This program will work irrespective of "
"whether the form uses a GET or POST method to send its "
"data over, which gives designers additional flexibility "
"(GET provides a weak form of persistence, while "
"POST is more robust and better suited to large volumes of "
"data).")
(p "Here's the entire program, once again:"
(pre " #!/bin/sh" (br)
" string=? ; exec /usr/local/bin/mzscheme -r $0 \"$@\"" (br)
"" (br)
" (require (lib \"cgi.ss\" \"net\"))" (br)
" (define finger-program \"/usr/bin/finger\")" (br)
"" (br)
" (let ((bindings (get-bindings)))" (br)
" (let ((name (extract-binding/single 'name bindings)))" (br)
" (let ((results (if (string=? name "")" (br)
" (process* finger-program)" (br)
" (process* finger-program name))))" (br)
" (let ((proc->self (car results)))" (br)
" (let ((strings (let loop " (br)
" (let ((l (read-line proc->self)))" (br)
" (if (eof-object? l)" (br)
" null" (br)
" (cons l (loop)))))))" (br)
" (generate-html-output \"Finger Gateway Output\"" (br)
" (append" (br)
" '(\"<pre>\")" (br)
" (map string->html strings)" (br)
" '(\"</pre>\"))))))))"))))
;;
("databases" "Databases"
((p "For ODBC databases see " (a ([href ,url-helpdesk-srpersist]) "SrPersist") ".")
(p "For bindings to MySQL, SQLite, PostGreSQL, and more see "
(a ([href ,url-external-planet]) "PLaneT") ".")))
;; was: /servlets/scheme/doc.ss
("documentation" "Documentation"
(,(make-green-header-text "How to use DrScheme")
(p (a ([href ,url-helpdesk-drscheme]) "DrScheme")
" provides information about using the DrScheme development environment.")
,(make-green-header-text "Languages and Libraries")
(p "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 ,url-helpdesk-how-to-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 ,url-helpdesk-manuals]) "Manuals"))
": List the currently installed and uninstalled manuals"))
,(make-green-header-text "Searching")
(p (a ([href ,url-helpdesk-how-to-search]) "Searching")
" in Help Desk finds documenation from all sources, including ")
(p (a ([href ,url-helpdesk-drscheme]) "DrScheme")
" and the language and library documentation.")))
;;
("drscheme" "DrScheme"
((p "DrScheme is PLT's flagship programming environment")
(ul (li (a ([href ,url-helpdesk-tour])
(b "Tour: ") "An introduction to DrScheme"))
(li (a ([href ,url-helpdesk-interface-essentials])
"Quick-start jump into the user manual"))
(li (a ([href ,url-helpdesk-languages])
"Languages: ")
"supported by DrScheme")
(li (a ([href ,url-helpdesk-drscheme-manual])
"PLT DrScheme: Programming Environment Manual")
(br)
"The complete user manual")
(li (a ([href ,url-helpdesk-drscheme-faq]) "FAQ")
": DrScheme Frequently asked questions")
(li (a ([href ,url-helpdesk-why-drscheme])
"Why DrScheme?")))))
;;
("graphics" "How to write graphics programs"
((p ; (a ([name "gfx"] [value "Graphics"]))
; (a ([name "gui"] [value "GUIs"]))
; (a ([name "gui2"] [value "Graphical User Interfaces"]))
"To write graphics programs, use DrScheme with the "
"Graphical (MrEd) flavor of the PLT "
(a ([href "/servlets/scheme/what.ss"]) " language") ". "
"MrEd provides a complete GUI toolbox that is described "
"in the manual for MrEd."
; TODO: make MrEd a link ,(main-manual-page "mred")
(p "For simple graphics programs, you may also use the "
"viewport-based graphics library, which is described in "
,(manual-entry "misclib" "viewport" "Viewport Graphics") ". "
"The following declaration loads viewport graphics into MrEd:"
(pre " (require (lib \"graphics.ss\" \"graphics\"))")))))
;;
("home" "PLT Help Desk Home"
((p "The Help Desk is a complete source of information about PLT software, "
"including DrScheme, MzScheme and MrEd.")
(p "There are two ways to find information in the Help Desk: searching and browsing.")
(h3 "Search the Help Desk")
(p "Search for keywords, index entries or raw text in the documentation pages"
(ul (li (i "Keywords: ") "are Scheme names, such as " (b "define") " and " (b "cons")".")
(li (i "Index entries: ") "are topical phrases, such as 'lists'.")
(li (i "Raw text: ") "are fragments of text from the documentation pages. "
"Use only as a last resort."))
"The Help Desk search results are sorted according to their source.")
(h3 "Browse the Help Desk")
(ul (li "The " (b "Home") " link will take you back to this page.")
(li "The " (b "Manuals") " link displays a list of manuals and other documentation")
#;(li "The " (b "Send a bug report") " link allows you to submit a bug report to PLT."))))
;;
("how-to-do-things-in-scheme" "How to do things in Scheme"
((p (ul
(li (a ([href ,url-helpdesk-stand-alone]) "How to build a stand-alone executable"))
(li (a ([href ,url-helpdesk-graphics]) "How to write graphics programs"))
(li (a ([href ,url-helpdesk-script]) "How to write Unix shell scripts"))
(li (a ([href ,url-helpdesk-batch]) "How to write Windows batch files"))
(li (a ([href ,url-helpdesk-cgi]) "How to write CGI scripts"))
(li (a ([href ,url-helpdesk-databases]) "How to connect to databases"))
(li (a ([href ,url-helpdesk-system]) "How to call low-level system routines"))))
(p "If you didn't find what you're looking for in the list above, try "
"searching in Help Desk. Also, check "
(a ((href "http://www.htus.org/")) (i "How to Use Scheme")) ".")))
;;
("how-to-search" "PLT Help Desk"
((p "The Help Desk is a complete source of information about PLT software, "
"including DrScheme, MzScheme and MrEd.")
(p "There are two ways to find information in the Help Desk: searching and browsing.")
(h3 "Search the Help Desk")
(p "Search for keywords, index entries or raw text in the documentation pages"
(ul (li (i "Keywords: ") "are Scheme names, such as " (b "define") " and " (b "cons")".")
(li (i "Index entries: ") "are topical phrases, such as 'lists'.")
(li (i "Raw text: ") "are fragments of text from the documentation pages. "
"Use only as a last resort."))
"The Help Desk search results are sorted according to their source.")
(h3 "Browse the Help Desk")
(ul (li "The " (b "Home") " link will take you back to this page.")
(li "The " (b "Manuals") " link displays a list of manuals and other documentation")
#;(li "The " (b "Send a bug report") " link allows you to submit a bug report to PLT."))))
;;
("known-bugs" "Known Bugs"
((p "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") ".")))
;;
("languages" "Scheme Languages"
((p "DrScheme supports many dialects of Scheme. "
"The following dialects are specifically designed for teaching "
"computer science. In DrScheme's "
;; TODO: (a ([href "/servlets/scheme/what.ss#lang-sel"]) "language selection menu")
(b "Language selection menu") ", "
"they are found under the heading "
(b "How to Design Programs") "."
(ul (li (b "Beginning Student") " is a pedagogical version of Scheme "
"that is tailored for beginning computer science students.")
(li (b "Beginning Student with List Abbreviations") " extends Beginning Student "
"with convenient (but potentially confusing) "
"ways to write lists, including quasiquote.")
(li (b "Intermediate Student") " adds local bindings and higher-order functions.")
(li (b "Intermediate Student with Lambda") " adds anonymous functions.")
(li (b "Advanced Student") " adds mutable state.")))
(p "The " (b "The 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 R5RS language is a standard dialect of Scheme that is defined by the "
"Revised^5 Report on the Algorithmic Language Scheme. "
"In DrScheme's language selection menu, the following languages are found under the heading PLT: ")
(ul (li (b "Textual (MzScheme)") " is a superset of R5RS Scheme. "
"In addition to 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 PLT MzScheme: Language Manual. ")
(li (b "Graphical (MrEd)") " includes the Textual (MzScheme) language "
"and adds a graphical toolbox, described in PLT MrEd: Graphical Toolbox Manual.")
(li (b "Pretty Big") " is a superset of the Graphical (MrEd) language, "
"and adds forms from the Pretty Big language. "
"For those forms that are in both languages, Pretty Big behaves like Graphical (MrEd)."))
(p "The " (b "module language") " supports development using PLT Scheme's module form, "
"where the module's language is explicitly declared in the code.")
(p "See 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 manuals page.")))
;;
("libraries" "Libraries"
((h3 "Built-in Libraries")
(p "PLT Scheme has a lot of libraries. The core libraries are described in "
(a ((href ,url-helpdesk-mzlib)) "PLT MzLib: Libraries Manual"))
(p "See the " (a ((href ,url-helpdesk-manuals)) "Manuals") " page for more.")
(h3 "User / PLaneT Libraries")
(p (a ((href ,url-external-planet)) "PLaneT") " is the repository for user contributed libraries. "
"Join the PLaneT announcement mailing list to get notified on new PLaneT packages.")))
;;
("license" "License"
((h2 "PLT Software")
(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 "
"the specific rules stated in the LGPL. You can also modify PLT "
"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?~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")))))])
"COPYING.LIB")
" for more information.")
(p "PLT software includes or extends the following copyrighted material:"
,@(map
(lambda (ss) `(ul (li ,@(map (lambda (s) `(div ,s (br))) ss))))
`(("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"
,(string-append "Copyright (c) 1994 Artificial Intelligence Applications Institute, "
"The University of Edinburgh")
"All rights reserved.")
("wxWindows Xt"
,(string-append "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"))))))
;;
("mailing-lists" "Mailing Lists"
((p "There are two mailing lists: the discussion list and the announcements only list.")
(h3 "Archives")
(p "The lists are archived:"
(ul (li (a ([href ,url-external-discussion-list-archive]) "Discussions")
" - " (a ([href ,url-external-discussion-list-archive-old]) "(old archive)"))
(li (a ([href ,url-external-announcement-list-archive]) "Announcements only"))))
(h3 "Subscribing")
(p "Visit the "
(a ((href ,url-external-mailing-list-subscription))
"subscription page")
" to join the mailing lists.")))
;;
("mrflow" "MrFlow"
((p "MrFlow is a user friendly, interactive static debugger for DrScheme that"
(ul (li "highlights operations that may cause errors;")
(li "computes invariants describing the set of values each program expression can assume; and")
(li "provides a graphical explanation for each invariant.")))
(p "The programmer can browse this information, and then resume program development "
"with an improved understanding of the program's execution behavior, and in "
"particular of potential run-time errors.")
(p "See the " (a ([href ,url-external-mrflow]) "MrFlow") " web-site.")))
;;
("mrspidey" "MrSpidey"
((p "MrSpidey is a static debugger for DrScheme v103p1.")
(p "See the " (a ([href ,url-external-mrspidey]) "MrSpidey") " web-site.")))
;;
("mzcom" "MzCom"
((p "MzCOM is a COM class containing an embedded MzScheme. With MzCOM, "
"you can run Scheme code from your favorite COM host environment, "
"such as Visual BASIC, Delphi, Visual FoxPro, Visual C++, or even PLT's MysterX.")
(p "See the " (a ([href ,url-external-mzcom]) "MzCom") " web-site.")))
;;
("mysterx" "MysterX"
((p "MysterX (\"Mister X\") is a toolkit for building Windows applications "
"within DrScheme or MzScheme using ActiveX and COM components. "
"Dynamic HTML is used for component presentation and event-handling.")
(p "See the " (a ([href ,url-external-mysterx]) "MysterX") " web-site.")))
;;
("note-on-language-levels" "A Note on Language Levels"
((p "DrScheme presents Scheme via a hierarchy of "
(a ([href ,url-helpdesk-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 Execute button."
" 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") ".")))
;;
("odbc" "ODBC"
((p "See " (a ([href ,url-helpdesk-srpersist]) "SrPersist") ".")))
;;
("patches" "Downloadable Patches"
((p "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)))))
;;
("program-design" "Program Design"
((h3 "For Students")
(p "The textbook " (a ((href "http://www.htdp.org")) "How to Design Programs")
" provides an introduction to programming using the DrScheme environment. "
"The Help Desk provides the following interactve support for the text book: "
(a ((href ,url-helpdesk-teachpacks)) "Teachpack documentation"))
(h3 "For Experienced Programmers")
(p (a ((href ,url-helpdesk-teach-yourself)) "Teach Yourself Scheme in a Fixnum Days")
": For programmers with lots of experience in other languages")
(h3 "For Teachers and Researchers")
(p (a ((href ,url-helpdesk-why-drscheme)) "PLT's vision"))))
;;
("release-notes" "Release Notes"
((h1 "Release Notes for PLT Scheme version " ,(version))
(a ([name "relnotes"] [VALUE "Release notes"]))
(p "Detailed release notes:"
(ul
,@(let ()
(define (make-release-notes-entry s)
(match s
[(label dir filename)
(let ([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))]))
(filter
values ; delete #f entries
(map make-release-notes-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")))))))))
;;
("script" "How to write Unix shell scripts"
((p "When MzScheme is installed as part of the standard Unix "
"PLT distribution, " (TT "plt/bin/mzscheme") " and "
(TT "plt/bin/mred") " are binary executables.")
(p "Thus, they can be used with Unix's " (TT "#!")
" convention as follows:"
(pre " #! /usr/local/lib/plt/bin/mzscheme -r ... " (br)
" " (I "scheme-program") " ...")
"assuming that the " (tt "plt") " tree is installed as "
(tt "/usr/local/lib/plt") ". "
"To avoid specifying an absolute path, use "
(tt "/usr/bin/env") ":"
(pre " #! /usr/bin/env mzscheme -r ... " (br)
" " (i "scheme-program") " ...")
(p "The above works when "
(tt "mzscheme") " is in the user's path. "
"The " (tt "mred") " executable can be used in the "
"same way for GUI scripts.")
(p "Within " (i "scheme-program") ", "
(tt "(current-command-line-arguments)")
" produces a vector of strings for the arguments "
"passed to the script. The vector is also available as "
(tt "argv") "."))))
;;
("srpersist" "SrPersist"
((p "SrPersist (\"Sister Persist\") is a set of Scheme bindings for the Open "
"Database Connectivity (ODBC) standard.")
(p "See the " (a ([href ,url-external-srpersist ]) "SrPersist") " web-site.")))
;;
("software" "Software"
((ul (li (a ((href ,url-helpdesk-drscheme)) "DrScheme") ": The programming environment")
(li (a ((href ,url-helpdesk-languages)) "Languages") ": The family of languages "
"supported by PLT Software")
;; (li (a ((href ,url-helpdesk-documentation)) "Documentation")
;; ": Organization and manuals")
;; (li (a ((href ,url-helpdesk-hints)) "Hints")
;; ": How to do things in Scheme")
)))
;;
("stand-alone" "How to build a stand-alone Executable"
((p "To create stand-alone executables, use DrScheme's "
(tt "Scheme | Create Executable ...")
" menu item. This menu is sensitive to the language levels; "
"the " (tt "module") " language permits the most flexibility "
"in creating executables.")
(p "The mzc compiler provides a more low-level interface "
"to stand-alone executables creation. "
"See " ,(main-manual-page "mzc") " for more information.")))
;;
("system" "How to call low-level system routines"
((p "To call low-level system routines, you must write "
"an extension to MzScheme using the C programming language. "
"See Inside MzScheme"
; TODO: #;,(main-manual-page "insidemz")
" for details.")))
;;
("teachpacks" "Teachpacks"
((ul (li (a ((href ,url-helpdesk-teachpacks-for-htdp))
"Teachpacks for 'How to Design Programs'"))
(li (a ((href ,url-helpdesk-teachpacks-for-htdc))
"Teachpacks for 'How to Design Classes'")))))
;;
("teachscheme" "TeachScheme"
((h2 "TeachScheme! Workshops")
(p "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 "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 "
"precise language; evaluate and revise these activities in "
"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") ".")))
;;
("tour" "Tour of DrScheme"
((p "Take a " (a ([href ,url-external-tour-of-drscheme]) "Tour of DrScheme")
" and discover the wealth of features of the interactive, "
"integrated programming environment.")))
;;
("why-drscheme" "Why DrScheme?"
((p "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"))
"DrScheme: A Programming Environment for Scheme."))))
)))

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

@ -1,2 +0,0 @@
(module info setup/infotab
(define name "Help Servlets"))

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

@ -1,31 +0,0 @@
(module manual-section mzscheme
(require (lib "servlet.ss" "web-server")
"../private/manuals.ss"
"private/html.ss")
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(with-errors-to-browser
send/finish
(lambda ()
(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
1 (sub1 (string-length raw-section)))]
[page (with-handlers
([void (lambda _
(send/finish
(html-page
#:title "Can't find manual section"
#:bodies
`("Error looking up PLT manual section"
(p "Requested manual: "
,manual (br)
"Requested section: "
,section)))))])
(finddoc-page-anchor manual section))])
(send/finish (redirect-to page)))))))

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

@ -1,11 +0,0 @@
(module manuals mzscheme
(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)
(with-errors-to-browser
send/finish
(lambda ()
(list #"text/html" (find-manuals))))))

191
collects/help/servlets/master-index.ss
View File

@ -1,191 +0,0 @@
(module master-index mzscheme
(require (lib "servlet.ss" "web-server")
(lib "xml.ss" "xml")
(lib "match.ss")
(lib "dirs.ss" "setup")
(lib "list.ss")
(lib "match.ss")
(lib "uri-codec.ss" "net")
"../private/options.ss"
"private/url.ss"
"../private/standard-urls.ss"
"private/html.ss"
"../private/search.ss")
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start request)
(with-errors-to-browser
send/finish
(lambda ()
(html-page
#:title "Master Index"
#:top (case (helpdesk-platform)
[(internal-browser) '()]
[(internal-browser-simple) '()]
[else (html-top request)])
#:body (html-master-index)))))
;;;
;;; ENTRIES
;;;
(define-struct entry (keyword) (make-inspector))
(define-struct (manual-entry entry) (host manual file label title) (make-inspector))
(define-struct (doc.txt-entry entry) (file offset title))
(define entries (make-hash-table 'equal))
;;;
;;; HTML
;;;
; html-entry : entry -> xexpr
; convert entry into link
(define (html-entry the-entry)
(match the-entry
[($ manual-entry keyword host manual file label title)
`(div 'nbsp 'nbsp 'nbsp 'nbsp
(a ([href ,(manual-file-path->url host manual file label)])
,title))]
[($ doc.txt-entry keyword file offset title)
`(div 'nbsp 'nbsp 'nbsp 'nbsp
(a ([href ,(doc.txt-file-path->url file title keyword offset)])
,title))]
[_ (error)]))
; html-keyword : string -> xexpr
; make xexpr with the keyword in bold followed by all associated entries
(define (html-keyword keyword)
`(div (b ,keyword)
,@(map html-entry (hash-table-get entries keyword))))
; html-master-index : -> xexpr
(define (html-master-index)
(let ([keywords (sort (hash-table-map entries (lambda (key val) key))
(lambda (s1 s2) (string<? (string-downcase s1) (string-downcase s2))))])
`(div (h1 "Master Index")
(p "This master index contains all keywords from the tex2page based manuals as well as doc.txt files.")
(p "All entries in keywords and hdindex files are thus included.")
(p "Keywords from Scribble generated manuals are not included yet.")
(p "PLaneT documentation is not included.")
,@(map html-keyword keywords))))
; manual-file-path->url : string string path string -> string
(define (manual-file-path->url host manual file label)
(string-append (url-static host manual file)
(if label (format "#~a" label) "")))
(define (doc.txt-file-path->url file caption name offset)
(format "/servlets/doc-anchor.ss?file=~a&caption=~a&name=~a&offset=~a#temp"
(path->string file)
(uri-encode caption)
(uri-encode name)
offset))
;;;
;;; ENTRIES
;;;
; add-entry! : entry ->
; register the keyword of entry in the hash-table entries
(define (add-entry! entry)
(let* ([keyword (entry-keyword entry)]
[old (hash-table-get entries keyword (lambda () '()))])
(hash-table-put! entries (entry-keyword entry) (cons entry old))))
; keyword->entry : string string list-from-keywords-file -> manual-entry
; convert list from keywords-file into an manual-entry
(define (keyword->entry host manual keyword-list)
(match keyword-list
[(keyword result-display html-file html-label title)
(make-manual-entry keyword host manual html-file html-label title)]
[_
(error 'keyword->entry
"Expected a five element list: (<keyword> <result-to-display> <html-file> <html-label> <title>), got: "
keyword-list)]))
; item->entry : string string list-from-hdindex-files -> manual-entry
; convert list from hdindex file into an entry
(define (item->entry host manual item-list)
(match item-list
[(item html-file html-label title)
(make-manual-entry item host manual html-file html-label title)]
[_
(error 'item->entry
"Expected a four element list: (<item> <html-file> <html-label> <title>), got: "
item-list)]))
;;;
;;; TRAVERSAL
;;;
; add-keywords-in-directory! : string string path ->
; add all keywords in <dir>/keywords to the entries hash-table
(define (add-keywords-in-directory! host manual dir)
(when (directory-exists? dir)
(let ([keywords-path (build-path dir "keywords")])
(when (file-exists? keywords-path)
(with-input-from-file keywords-path
(lambda ()
(let ([keyword-entries (read)])
(for-each (lambda (k) (add-entry! (keyword->entry host manual k)))
keyword-entries))))))))
; add-items-in-directory! : string string path ->
; add all items in <dir>/hdindex to the entries hash-table
(define (add-items-in-directory! host manual dir)
(when (directory-exists? dir)
(let ([items-path (build-path dir "hdindex")])
(when (file-exists? items-path)
(with-input-from-file items-path
(lambda ()
(let ([item-entries (read)])
(for-each (lambda (k) (add-entry! (item->entry host manual k)))
item-entries))))))))
; add-keywords-and-items-in-sub-directories! : (cons string path) ->
; add all keywords in the keywords-files path/*/keywords to the hash-table entries
; add all items in the hdindex-files path/*/hdindex to the hash-table entries
(define (add-keywords-in-sub-directories! host+dir)
(match host+dir
[(host . dir)
(when (directory-exists? dir)
(for-each (lambda (manual)
(add-keywords-in-directory! host manual (build-path dir manual))
(add-items-in-directory! host manual (build-path dir manual)))
(directory-list dir)))]))
(define (add-keywords-in-doc.txt-file doc name)
(let ([ht (make-hash-table 'equal)])
(load-txt-keywords-into-hash-table ht doc)
(hash-table-for-each
ht (lambda (key val)
(for-each (lambda (item)
(match item
[(keyword title doc.txt-path offset _)
(add-entry!
(make-doc.txt-entry keyword key offset title))]))
val)))))
; add-keywords-in-doc.txt-files : ->
(define (add-keywords-in-doc.txt-files)
(reset-doc-lists)
(let-values ([(pathss names types) (extract-doc-txt)])
(for-each
(lambda (paths name type)
(match paths
[(base-path doc-txt)
(add-keywords-in-doc.txt-file paths name)]))
pathss names types)))
; make the traversal
(for-each add-keywords-in-sub-directories!
host+dirs)
(add-keywords-in-doc.txt-files)
)

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

@ -1,42 +0,0 @@
(module missing-manual mzscheme
(require (lib "servlet.ss" "web-server")
"../private/standard-urls.ss"
"private/util.ss"
"private/html.ss")
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(with-errors-to-browser
send/finish
(lambda ()
(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-page
#:title "Missing PLT manual"
#:bodies
`(,(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.")
(br)
(h2 "Install Locally")
(p (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")
(p "Read the documentation on "
(a ((href ,html-url)) "PLT's servers")
"."))))))

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

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

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

@ -1,13 +0,0 @@
(module external mzscheme
(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.")))))))

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

@ -1,50 +0,0 @@
;; elements to go in HEAD part of HTML document
(module headelts mzscheme
(require (lib "list.ss"))
(provide hd-css hd-links)
;; 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)
(define css-rules
'([body (background-color white) (font-family (Helvetica sans-serif))]))
(define (css-rules->style)
(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
(define hd-links
`((link ([rel "icon"] [href "/help/servlets/plticon.ico"]
[type "image/ico"]))
(link ([rel "SHORTCUT ICON"] [href "/help/servlets/plticon.ico"])))))

6
collects/help/servlets/private/helpdesk.css
View File

@ -1,6 +0,0 @@
.sansa { font-family: Arial, Helvetica, sans-serif; }
.sansa a:link { color: #3a652b; text-decoration: none; background-color: transparent; }
.sansa a:visited { color: #3a652b; text-decoration: none; background-color: transparent; }
.sansa a:active { color: #3a652b; text-decoration: none; background-color: #97d881; }
.sansa a:hover { color: #3a652b; text-decoration: none; background-color: #97d881; }
body { background-color: white; font-family: Arial, Helvetica, sans-serif; }

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

@ -1,187 +0,0 @@
(module html mzscheme
(provide (all-defined))
(require (lib "servlets/private/search-util.ss" "help")
(lib "servlet.ss" "web-server")
(lib "etc.ss")
(lib "kw.ss")
(lib "port.ss")
"../../private/options.ss"
"util.ss"
"url.ss")
;;;
;;; STYLESHEET
;;;
;; css : -> string
;; fetch stylesheet from disk
;; (convenient during development)
(define (css)
(define (port->string port)
(let ([os (open-output-string)])
(copy-port port os)
(get-output-string os)))
(call-with-input-file (build-path (this-expression-source-directory)
"helpdesk.css")
port->string))
;;;
;;; HTML FOR THE INTERNAL HELPDESK
;;;
(define (make-green-header-text s)
(color-highlight `(h2 () ,s)))
(define (br*)
(if (eq? (helpdesk-platform) 'external-browser)
'()
'((br) (br))))
;;;
;;; GENERATE XML FOR THE ENTIRE PAGE
;;;
;; html-page : xexpr (list xml) (list xml) -> xexpr
(define/kw (html-page #:key title (top '()) (bodies '()) body)
(let ([bodies (if body (append bodies (list body)) bodies)])
`(html
(meta ([http-equiv "Content-Type"] [content "text/html;charset=UTF-8"]))
(meta ([name "generator"] [content "PLT Scheme"]))
;; TODO: Ask Eli what exactly to put here in the online version
;; (script ([src "http://www.google-analytics.com/urchin.js"]
;; [type "text/javascript"]))
;; (script ([type "text/javascript"])
;; "_uacct=\"UA-808258-1\";_udn=\"plt-scheme.org\";urchinTracker();")
(head
(title ,title)
(style ([type "text/css"]) "\n" ,(css))
;; TODO: Check the icons work in online version
(link ([rel "icon"] [href "/help/servlets/plticon.ico"]
[type "image/ico"]))
(link ([rel "shortcut icon"] [href "/help/servlets/plticon.ico"])))
(body ,@top ,@bodies))))
;; html-select : string (list string) natural -> xexpr
(define (html-select name descriptions selected-index)
`(select ([name ,name])
,@(let loop ([i 0] [ds descriptions] [xexprs '()])
(cond [(null? ds) (reverse xexprs)]
[(= i selected-index)
(loop (+ i 1) (cdr ds)
(list* (car ds) `(option ((selected "selected")))
xexprs))]
[else (loop (+ i 1) (cdr ds)
(list* (car ds) `(option) xexprs))]))))
;;;
;;; THE TOP SEARCH BAR
;;; (online version online)
;; html-top : requrest -> (list xml)
(define (html-top request)
(define bindings (request-bindings request))
(define search-string (get-binding bindings 'search-string ""))
(define search-type (get-binding bindings 'search-type search-type-default))
(define match-type (get-binding bindings 'match-type match-type-default))
`((div ([style "border: 1px solid black; padding: 3px; background-color: #74ca56;"])
(table ([width "98%"])
(tr (td ([align "right"])
(img ([class "image"]
[src "http://www.plt-scheme.org/plt-green.jpg"]
[width "133"] [height "128"] [alt "[icon]"])))
(td ([align "center"])
(form ([method "GET"] [action ,url-helpdesk-results])
(table (tr (td ([align "center"] [class "sansa"])
"Search the Help Desk for documentation on: "))
(tr (td (input ([name "search-string"] [type "text"]
[size "70"] [value ,search-string])))
(td nbsp nbsp (button "Search")))
(tr (td ([align "center"])
,(html-select "search-type"
search-type-descriptions
(search-type->index search-type))
nbsp nbsp nbsp nbsp
,(html-select "match-type"
match-type-descriptions
(match-type->index match-type)))))))
(td nbsp) (td nbsp) (td nbsp)
(td (table (tr (td ([align "center"])
(a ([href ,url-helpdesk-home] [class "sansa"])
"HOME")))
(tr (td ([align "center"])
(a ([href ,url-helpdesk-manuals] [class "sansa"])
"MANUALS"))))))))
(p " ")))
;;;
;;; BINDINGS
;;;
(define (get-binding bindings name default-value)
(if (exists-binding? name bindings)
(extract-binding/single name bindings)
default-value))
(define (delete-binding id bindings)
(cond [(null? bindings) '()]
[(equal? (binding-id (car bindings)) id) (cdr bindings)]
[else (cons (car bindings) (delete-binding id (cdr bindings)))]))
(define (delete-bindings ids bindings)
(if (null? ids)
bindings
(delete-bindings (cdr ids) (delete-binding (car ids) bindings))))
(define (display-binding binding)
;; for debugging
(printf "binding: ~a=~s\n"
(binding-id binding)
(binding:form-value binding)))
;;;
;;; SEARCH DESCRIPTIONS AND SHORT NAMES
;;;
(define (search-type-description i)
(cadr (list-ref search-types i)))
(define (match-type-description i)
(cadr (list-ref match-types i)))
(define reversed-search-types
(map reverse search-types))
(define reversed-match-types
(map reverse match-types))
(define (search-type-description->search-type desc)
(cond [(assoc desc reversed-search-types) => cadr]
[else search-type-default]))
(define (match-type-description->match-type desc)
(cond [(assoc desc reversed-match-types) => cadr]
[else match-type-default]))
(define search-type->index
(let* ([types (map car search-types)]
[len (length types)])
(lambda (t)
(cond [(member t types) => (lambda (tail) (- len (length tail)))]
[else -1]))))
(define match-type->index
(let* ([types (map car match-types)]
[len (length types)])
(lambda (t)
(cond [(member t types) => (lambda (tail) (- len (length tail)))]
[else -1]))))
(define search-type-descriptions
(map cadr search-types))
(define match-type-descriptions
(map cadr match-types))
)

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

@ -1,2 +0,0 @@
(module info setup/infotab
(define name "Help Desk servlets private"))

53
collects/help/servlets/private/mime.ss
View File

@ -1,53 +0,0 @@
(module mime mzscheme
(provide (all-defined))
(require (lib "private/mime-types.ss" "web-server")
(lib "dirs.ss" "setup")
(lib "port.ss")
"../../private/docpos.ss")
;;;
;;; MIME
;;;
; get-mime-type : path -> string
(define get-mime-type
(let ([path->mime-type
(make-path->mime-type
(build-path (find-collects-dir)
"web-server" "default-web-root" "mime.types"))])
(lambda (file)
(path->mime-type
(if (string? file)
(string->path file)
file)))))
(define (text-mime-type? file-path)
(regexp-match #rx"^text"
(get-mime-type file-path)))
;;;
;;; PORT UTILS
;;;
(define (port->string port)
(let ([os (open-output-string)])
(copy-port port os)
(get-output-string os)))
(define (file->string path)
(call-with-input-file path
port->string))
(define (port->bytes port)
(let ([ob (open-output-bytes)])
(copy-port port ob)
(get-output-bytes ob)))
(define (file->bytes path)
(call-with-input-file path
port->bytes))
)

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

@ -1,39 +0,0 @@
(module read-doc mzscheme
(require (lib "etc.ss")
(lib "getinfo.ss" "setup")
(lib "xml.ss" "xml")
"../../private/options.ss"
"util.ss"
"read-lines.ss"
"html.ss"
"mime.ss")
(provide read-doc)
;; extracts help desk message
(define (get-message coll)
(with-handlers ([void (lambda _ #f)]) ; collection may not exist
((get-info (list coll)) 'help-desk-message (lambda () #f))))
(define offset-format "file=~a&caption=~a&offset=~a#temp")
(define (build-page request file-path caption coll offset)
(html-page
#:title (if (string? caption) caption "Documentation")
#:top (case (helpdesk-platform)
[(internal-browser internal-browser-simple) '()]
[else (html-top request)])
#:body
(let ([msg (get-message coll)])
(cond
[(not file-path)
(format "File not found.")]
[(file-exists? file-path)
(if msg
`(div (p ,msg) ,(read-lines file-path caption offset))
(read-lines file-path caption offset))]
[else
(format "File not found: ~a" file-path)]))))
(define read-doc
(opt-lambda (request file caption coll [offset #f])
(build-page request file caption coll offset))))

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

@ -1,139 +0,0 @@
(module read-lines mzscheme
(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)
'()
(list* (caar lst) (cadar lst) (semi-flatten (cdr lst)))))
(define temp-anchor `(a ((name "temp")) ""))
(define (spacify s)
(if (and (string? s) (string=? s ""))
" " ; to appease IE
s))
(define (template caption lines)
`(table ([cellpadding "0"] [cellspacing "0"])
(b ,(with-color "blue" caption))
(p)
(pre ([style "font-family:monospace"])
;; use <BR>'s instead of newlines, for Opera don't put in a <BR>
;; for the temp-anchor, which wasn't a line in the source
,@(semi-flatten
(map (lambda (ln)
(if (eq? ln temp-anchor)
`(,ln "")
`(,(spacify ln) (BR)))) lines)))))
(define url-regexp-base "://([^\\s]*)($|\\s|(\\.(\\s|$))|>)")
(define trailing-regexp (pregexp "[\\s>)(\"]"))
(define (make-url-regexp ty)
(pregexp (string-append ty url-regexp-base)))
(define http-regexp (make-url-regexp "http"))
(define (http-format url) `(a ((href ,url)) ,url))
(define ftp-regexp (make-url-regexp "ftp"))
(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))
(define (rtrim s)
(let* ([presult (regexp-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)))
(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 (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)])
(if (and (> len 3)
(char=? (string-ref line 0) #\>))
(let* ([rest-of-line (substring line 1 len)]
[port (open-input-string rest-of-line)]
[dist
(with-handlers ([exn:fail:read? (lambda (x) #f)])
(read port)
(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))
#f)))
;; 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))))
(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"))]
[process-line
(if doc-txt?
process-doc-line
(lambda (x) x))]
[lines (let loop ([lines '()])
(let ([line (read-line port)])
(if (eof-object? line)
(begin
(close-input-port port)
(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)))))

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

@ -1,25 +0,0 @@
(module search-util mzscheme
(require (lib "string-constant.ss" "string-constants"))
(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))))
(define search-type-default "keyword-index")
(define match-types
`(("exact-match" ,(string-constant plt:hd:exact-match))
("containing-match" ,(string-constant plt:hd:containing-match))
("regexp-match" ,(string-constant plt:hd:regexp-match))))
(define match-type-default "containing-match")
(define kind-types
`(("index entries" html)
("keyword entries" text)
("text" text))))

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

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

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

@ -1,83 +0,0 @@
(module url mzscheme
(require "../../private/internal-hp.ss")
(provide (all-defined))
(define url-helpdesk-root
(format "http://~a:~a/servlets/" internal-host (internal-port)))
(define url-helpdesk-home (string-append url-helpdesk-root "home.ss"))
(define url-helpdesk-results (string-append url-helpdesk-root "results.ss"))
(define url-helpdesk-master-index (string-append url-helpdesk-root "master-index.ss"))
(define (url-home-subpage subpage-str)
(string-append url-helpdesk-home "?subpage=" subpage-str))
(define (version-major)
; TODO: Fix this
(cond [(regexp-match #px"^(\\d+).*$" (version))
=> cadr]
[else "352"]))
(define (url-manual-on-doc-server manual)
(format "http://download.plt-scheme.org/doc/~a/html/~a/"
(version-major) manual))
(define (url-static doc manual path)
(format "~astatic.ss/~a/~a/~a"
url-helpdesk-root doc manual path))
(define url-external-announcement-list-archive "http://list.cs.brown.edu/pipermail/plt-announce/")
(define url-external-discussion-list-archive "http://list.cs.brown.edu/pipermail/plt-scheme/")
(define url-external-discussion-list-archive-old "http://www.cs.utah.edu/plt/mailarch/")
(define url-external-mailing-list-subscription "http://www.plt-scheme.org/maillist/")
(define url-external-mrflow "http://www.plt-scheme.org/software/mrflow/")
(define url-external-mrspidey "http://www.plt-scheme.org/software/mrspidey/")
(define url-external-mysterx "http://www.plt-scheme.org/software/mysterx/")
(define url-external-mzcom "http://www.plt-scheme.org/software/mzcom/")
(define url-external-send-bug-report "http://bugs.plt-scheme.org/")
(define url-external-tour-of-drscheme "http://www.plt-scheme.org/software/drscheme/tour/")
(define url-external-planet "http://planet.plt-scheme.org/")
(define url-external-srpersist "http://www.plt-scheme.org/software/srpersist/")
(define url-helpdesk-acknowledge (url-home-subpage "acknowledge"))
(define url-helpdesk-batch (url-home-subpage "batch"))
(define url-helpdesk-books (url-home-subpage "books"))
(define url-helpdesk-cgi (url-home-subpage "cgi"))
(define url-helpdesk-databases (url-home-subpage "databases"))
(define url-helpdesk-documentation (url-home-subpage "documentation"))
(define url-helpdesk-drscheme (url-home-subpage "drscheme"))
(define url-helpdesk-drscheme-faq (url-static "doc1" "drscheme" "drscheme-Z-H-5.html#node_chap_5"))
(define url-helpdesk-drscheme-manual (url-static "doc1" "drscheme" "index.htm"))
(define url-helpdesk-faq (url-home-subpage "faq"))
(define url-helpdesk-graphics (url-home-subpage "graphics"))
(define url-helpdesk-help (url-home-subpage "help"))
(define url-helpdesk-how-to-search (url-home-subpage "how-to-search"))
(define url-helpdesk-interface-essentials (url-static "doc1" "drscheme" "drscheme-Z-H-2.html#node_chap_2"))
(define url-helpdesk-known-bugs (url-home-subpage "known-bugs"))
(define url-helpdesk-languages (url-home-subpage "languages"))
(define url-helpdesk-libraries (url-home-subpage "libraries"))
(define url-helpdesk-license (url-home-subpage "license"))
(define url-helpdesk-manuals (url-home-subpage "manuals"))
(define url-helpdesk-mailing-lists (url-home-subpage "mailing-lists"))
(define url-helpdesk-mzlib (url-static "doc1" "mzlib" "mzlib.html"))
(define url-helpdesk-patches (url-home-subpage "patches"))
(define url-helpdesk-program-design (url-home-subpage "program-design"))
(define url-helpdesk-release (url-home-subpage "release"))
(define url-helpdesk-release-notes (url-home-subpage "release-notes"))
(define url-helpdesk-script (url-home-subpage "script"))
(define url-helpdesk-search (url-home-subpage "search"))
(define url-helpdesk-software (url-home-subpage "software"))
(define url-helpdesk-srpersist (url-home-subpage "srpersist"))
(define url-helpdesk-stand-alone (url-home-subpage "stand-alone"))
(define url-helpdesk-system (url-home-subpage "system"))
(define url-helpdesk-teachpacks (url-home-subpage "teachpacks"))
(define url-helpdesk-teachscheme (url-home-subpage "teachscheme"))
(define url-helpdesk-teachpacks-for-htdp (url-static "doc1" "teachpack" "index.html#HtDP"))
(define url-helpdesk-teachpacks-for-htdc (url-static "doc1" "teachpack-htdc" "index.html#HtDC"))
(define url-helpdesk-teach-yourself (url-static "doc1" "t-y-scheme" "index.htm"))
(define url-helpdesk-tour (url-home-subpage "tour"))
(define url-helpdesk-why-drscheme (url-home-subpage "why-drscheme"))
)

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

@ -1,114 +0,0 @@
(module util mzscheme
(require (lib "file.ss")
(lib "list.ss")
(lib "xml.ss" "xml")
(lib "uri-codec.ss" "net")
(lib "string-constant.ss" "string-constants")
(lib "contract.ss"))
;; would be nice if this could use version:version from the framework.
(define (plt-version)
(let ([mz-version (version)]
[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 "repos-time-stamp/stamp.ss") 'stamp))
mz-version)))
(define home-page
`(a ([href "/servlets/home.ss"] [target "_top"])
,(string-constant plt:hd:home)))
(define (get-pref/default pref default)
(get-preference pref (lambda () default)))
(define (get-bool-pref/default pref default)
(let ([raw-pref (get-pref/default pref default)])
(if (string=? raw-pref "false") #f #t)))
(define (put-prefs names vals)
(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 *the-highlight-color* "forestgreen")
;; string xexpr ... -> xexpr
(define (with-color color . s)
`(font ([color ,color]) ,@s))
;; xexpr ... -> xexpr
(define (color-highlight . s)
(apply with-color *the-highlight-color* s))
(define repos-or-nightly-build?
(let ([helpdir (collection-path "help")])
(lambda ()
(or (directory-exists? (build-path helpdir ".svn"))
(directory-exists? (build-path helpdir "CVS"))
(with-handlers ([exn:fail:filesystem? (lambda (x) #f)])
(collection-path "repos-time-stamp"))))))
; string string -> xexpr
(define (collection-doc-link coll txt)
(let ([coll-file (build-path (collection-path coll) "doc.txt")])
(if (file-exists? coll-file)
`(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"
(define (fold-into-web-path lst)
(foldr (lambda (s a) (if a (string-append s "/" a) s)) #f lst))
(define (format-collection-message s)
`(b ((style "color:green")) ,s))
(define (make-javascript . 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 "\"")
"}"))
(define (onload-redir secs)
(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
repos-or-nightly-build?
search-height-default
search-bg-default
search-text-default
search-link-default
color-highlight
with-color
collection-doc-link
home-page
format-collection-message
plt-version
make-javascript
redir-javascript
onload-redir))

2
collects/help/servlets/release/info.ss
View File

@ -1,2 +0,0 @@
(module info setup/infotab
(define name "Help Servlets Release"))

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

@ -1,44 +0,0 @@
(module notes mzscheme
(require (lib "servlet.ss" "web-server")
(lib "list.ss")
(lib "uri-codec.ss" "net")
(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)))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(with-errors-to-browser
send/finish
(lambda ()
`(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")))))))))))

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

@ -1,30 +0,0 @@
(module releaseinfo mzscheme
(require "private/util.ss"
"private/headelts.ss"
(lib "servlet.ss" "web-server")
(lib "dirs.ss" "setup"))
(define (link-stuff url txt)
`(li (b (a ([href ,url]) ,txt))))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(with-errors-to-browser
send/finish
(lambda ()
`(html
(head ,hd-css ,@hd-links (title "Release Information"))
(body
(h1 "Release Information")
(p (i "Version: " ,(plt-version)))
(br)
(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 ,(path->string (find-collects-dir))))))))))

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

@ -1,32 +0,0 @@
(module resources mzscheme
(require (lib "servlet.ss" "web-server")
"private/html.ss")
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(with-errors-to-browser
send/finish
(lambda ()
(html-page
#:title "External Resources"
#:bodies
`((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.")
(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/") ".")))))))

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

@ -1,335 +0,0 @@
#|
Since the web server is set up to have a separate namespace for each
servlet, this servlet must be able to both use and flush the documentation
index cache. Flushing the cache elsewhere will not dump it, since the cache
is stored in a module top-level and that's namespace-specific.
|#
(module results mzscheme
(require (lib "file.ss")
(lib "string.ss")
(lib "servlet.ss" "web-server")
(lib "uri-codec.ss" "net")
(lib "dirs.ss" "setup")
"../private/path.ss"
"../private/search.ss"
"../private/manuals.ss"
"../private/get-help-url.ss"
(lib "string-constant.ss" "string-constants")
"private/util.ss"
"private/search-util.ss"
"private/html.ss"
"../private/options.ss")
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
; adjust-request : request -> request
; The bindings received by the online and the internal helpdesk
; for the search and match type are different.
; The online version contains user readable descriptions for search-type
; and match-type. This function changes them to use the short versions
; as the internal HelpDesk does.
(define (adjust-request request)
(case (helpdesk-platform)
[(internal-browser) request]
[(internal-browser-simple) request]
[else
(let* ([bindings (request-bindings request)]
[search-type (search-type-description->search-type
(get-binding bindings 'search-type search-type-default))]
[match-type (match-type-description->match-type
(get-binding bindings 'match-type match-type-default))]
[bindings (append (list (make-binding:form #"search-type" (string->bytes/utf-8 search-type))
(make-binding:form #"match-type" (string->bytes/utf-8 match-type)))
(delete-bindings (list #"search-type" #"match-type")
(request-bindings/raw request)))]
[request (make-request (request-method request)
(request-uri request)
(request-headers/raw request)
bindings
(request-post-data/raw request)
(request-host-ip request)
(request-host-port request)
(request-client-ip request))])
request)]))
(define (start initial-request)
(with-errors-to-browser
send/finish
(lambda ()
(let* ([request (adjust-request initial-request)]
[html-for-top (case (helpdesk-platform)
[(internal-browser) '()]
[(internal-browser-simple) '()]
[else (html-top request)])])
;; 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)))))
(define search-responses #f)
;; from what I can tell, this variable doesn't work as intended.
;; I've left it in for now, but this whole file needs to be rewritten.
;; -robby
(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! search-responses
(cons `(b ,(with-color
"red"
(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
(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))))
(define exp-web-root
(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)
(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))
(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-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 "\"")))))
;; 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)])))
;; 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/"
(define (make-anchored-path page-label 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")
(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)
0)])
(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"))))
(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)
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))))
(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))))
(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-page
#:title (format "PLT Scheme HelpDesk: ~a" search-string)
#:top html-for-top
#:bodies
`((h1 "Search Results")
(h2
,@(if lang-name
(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)
,@items))))
(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)]
[regexp? (string=? match-type "regexp-match")]
[exact-match? (string=? match-type "exact-match")]
[key (gensym)]
[result (let/ec k
(do-search search-string
search-level
regexp?
exact-match?
manuals
doc-txt?
key
(build-maxxed-out k)
add-header
set-current-kind!
(if lucky? goto-lucky-entry add-entry)))]
[html (make-results-page
search-string
lang-name
(if (string? result) ; error message
`((h2 ([style "color:red"]) ,result))
(reverse search-responses))
regexp?
exact-match?)])
html))
(define empty-search-page
; TODO: Improve UI: Feedback possibility
(html-page
#:title "Empty search string in PLT Help Desk"
#:top html-for-top
#: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)))
(define (convert-manuals manuals)
(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 request)]
[maybe-get (lambda (sym)
(with-handlers ([exn:fail?
(lambda (_) #f)])
(extract-binding/single sym bindings)))]
[flush (maybe-get 'flush)])
(cond
[flush
(doc-collections-changed)
(html-page #:title "Flushed documentation cache"
#:top (html-top initial-request)
#:body '(h2 "Flushed documentation cache"))]
[else
(let ([search-string (maybe-get 'search-string)]
[search-type (maybe-get 'search-type)]
[match-type (maybe-get 'match-type)]
[manuals (maybe-get 'manuals)]
[doc.txt (maybe-get 'doctxt)]
[lang-name (maybe-get 'langname)])
(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)))])))))))

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

@ -1,117 +0,0 @@
(module how mzscheme
(require (lib "launcher.ss" "launcher")
"../private/util.ss"
"../../private/manuals.ss"
"../private/headelts.ss"
"../../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)
(with-errors-to-browser
send/finish
(lambda ()
(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)))))))))

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

@ -1,2 +0,0 @@
(module info setup/infotab
(define name "Help Servlets Scheme"))

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

@ -1,105 +0,0 @@
(module what mzscheme
(require "../private/util.ss"
"../../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 (standout-text s)
(with-color "forestgreen" `(B ,s)))
(define (start initial-request)
(with-errors-to-browser
send/finish
(lambda ()
`(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"])
"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."))
"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"]))
,(standout-text "R5RS")
" language is a standard dialect of Scheme that is defined by the "
,(main-manual-page "r5rs") ". "
(a ([name "full"] [value "PLT Scheme language"]))
"In DrScheme's "
(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"]))
,(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"]))
"To change the"
" language, select the " (b "Choose Language...") " item in the "
(B "Language") " menu."))))))

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

@ -1,84 +0,0 @@
;; Serve static documentation.
;; A search bar is added on top of the screen, when an external browser is used.
;; (which is why we don't let the web-server serve the documentation directly)
(module static mzscheme
(require (lib "servlet.ss" "web-server")
(lib "xml.ss" "xml")
(lib "match.ss")
(lib "url.ss" "net")
"../private/standard-urls.ss"
"../private/docpos.ss"
"../private/options.ss"
"private/html.ss"
"private/mime.ss")
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
;;;
;;; URL
;;;
; file-parts->file : string (list string) -> string
; (list "foo" "bar" "baz") => "foo/bar/baz"
(define (file-parts->file manual fs)
(apply string-append
(let loop ([fs (cons manual fs)])
(cond
[(null? fs) (list "")]
[(null? (cdr fs)) (list (car fs))]
[else (cons (string-append (car fs) "/")
(loop (cdr fs)))]))))
;;;
;;; TITLES
;;;
(define (short->manual-title s)
(match (assoc (string->path s) known-docs)
[#f "Documentation"]
[(path . long) long]))
(define (start request)
(with-errors-to-browser
send/finish
(lambda ()
(let* ([bindings (request-bindings request)]
[file (get-binding bindings 'file "no file")]
[host (get-binding bindings 'host "no host")]
[url (request-uri request)])
(let-values
([(file-path host manual)
(match (map path/param-path (url-path url))
[("servlets" "static.ss" host manual . file-parts)
(values (host+file->path host (file-parts->file manual file-parts))
host
manual)])])
(cond
[(not file-path)
(list #"text/html"
"<html><head><title>Not found</title></head><body>File not found.</body></html>")]
[(and (file-exists? file-path)
(text-mime-type? file-path))
(list (get-mime-type file-path)
(string-append (xexpr->string
(html-page
#:title (short->manual-title manual)
#:top (case (helpdesk-platform)
[(internal-browser) '()]
[(internal-browser-simple) '()]
[else (html-top request)])
#:body " "))
(file->string file-path)))]
[(file-exists? file-path)
(list (get-mime-type file-path)
(file->bytes file-path))]
[else
(list #"text/html"
(format "<html><head><title>Not found</title></head><body>File not found: ~a</body></html>"
file-path))]))))))
)

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

@ -1,19 +0,0 @@
(module teachpacks mzscheme
(require "private/util.ss"
"../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)
(with-errors-to-browser
send/finish
(lambda ()
`(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\""))))))))))