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

misc improvements

Browse Source 
svn: r7189
This commit is contained in:
Eli Barzilay 2007-08-27 00:50:44 +00:00
parent 74b20d58d1
commit b4dd7515c4
1 changed files with 414 additions and 419 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -19,22 +19,21 @@
(define interface-version 'v1)
(define timeout +inf.0)
; html-subpage : xexprs -> xexpr
;; html-subpage : xexprs -> xexpr
(define (html-subpage . xs)
(case (helpdesk-platform)
[(internal-browser-simple)
(apply make-simple-page/internal-browser xs)]
[(internal-browser)
(apply make-split-page/internal-browser xs)]
[else
(apply make-split-page 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
;; 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")))
(make-request 'get (string->url "") '() '() #f "localhost"
(internal-port) "localhost")))
(with-errors-to-browser
send/finish
(lambda ()
@ -42,9 +41,9 @@
[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
;; dispatch on subpage
;; the dynamic ones (manuals and release) are handled are here,
;; the static pages below
(match subpage
["manuals"
(html-subpage
@ -60,42 +59,38 @@
(p)
(i "Version: " ,(plt-version))))]
["release"
(let ()
(define (link-stuff url txt) `(li (b (a ([href ,url]) ,txt))))
(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 HelpDesk from "
"within DrScheme. "
"The following information reflects the installation on this server only.")
(p "To see the release information for your installation,"
" use the HelpDesk from within DrScheme."
" The following information reflects the installation on"
" this server only.")
(h1 "Release Information")
(p)
(i "Version: " ,(plt-version))
(p)
(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)
(p "The PLT software is installed on this machine at" (br)
(pre nbsp nbsp
,(let-values ([(base file dir?)
(split-path (collection-path "mzlib"))])
(path->string base))))))))]
,(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
;; 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)
right-header
(append (left-items)
`(((p)
(i "Version: " ,(plt-version))))))]
[else
@ -104,7 +99,7 @@
(left-items)
right-header right-items)]))])))))
(define (br)
(define (br*)
(if (eq? (helpdesk-platform) 'external-browser)
'()
'((br) (br))))
@ -114,7 +109,7 @@
("Get help: "
nbsp nbsp nbsp nbsp
(b (a ((href ,url-helpdesk-help)) "Help Desk"))
,@(br))
,@(br*))
-- --
("Learn to program in Scheme: "
nbsp nbsp nbsp nbsp
@ -128,7 +123,7 @@
(a ((href ,url-helpdesk-books)) "Books") ", "
(a ((href ,url-helpdesk-languages)) "Languages") ", "
(a ((href ,url-helpdesk-teachpacks)) "Teachpacks")
,@(br))
,@(br*))
-- --
("How to run programs: "
nbsp nbsp nbsp nbsp (b (a ((href ,url-helpdesk-software)) "Software: "))
@ -136,17 +131,18 @@
(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 the DrScheme page
,@(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))
[(external-browser)
`(", " (a ((href ,url-external-send-bug-report)) "Send a bug report"))]
[else '()])
,@(br*))
-- --
(""
" " " "
@ -157,7 +153,7 @@
(font ([color "forestgreen"]) "Send a bug report")))
nbsp nbsp)]
[else `()])
; DrScheme Acknowledgements
;; DrScheme Acknowledgements
,@(case (helpdesk-platform)
[(internal-browser internal-browser-simple)
`((b (a ((href ,url-helpdesk-acknowledge))
@ -165,15 +161,14 @@
[else '()]))
-- -- -- --))
; page-tag->title+items : string -> (values string list-of-right-items)
;; 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)]))
; static subpages
; - In ALPHABETICAL order
;; static subpages
;; - In ALPHABETICAL order
(define easy-pages
`(("acknowledge" "Acknowledgements"
((p ,(get-general-acks))
@ -225,7 +220,7 @@
((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")
;; 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") "."
@ -289,10 +284,8 @@
"COPYING.LIB")
" for more information.")
(p "PLT software includes or extends the following copyrighted material:"
,@(let ()
(define (make-item ss) `(ul (li ,@(map (lambda (s) `(div ,s (br))) ss))))
(map
make-item
,@(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)
@ -343,7 +336,7 @@
("GNU lightning"
"Copyright (c) 1994, 1995, 1996, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.")
("GNU Classpath"
"GNU Public License with special exception")))))))
"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")
@ -352,8 +345,10 @@
" - " (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.")))
(p "Visit the "
(a ((href ,url-external-mailing-list-subscription))
"subscription page")
" to join the mailing lists.")))
("patches" "Downloadable Patches"
((p (a ([name "patches"] [value "Downloadable patches"]))
"The following Web page may contain downloadable patches to fix "
@ -404,10 +399,10 @@
((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")
;; (li (a ((href ,url-helpdesk-documentation)) "Documentation")
;; ": Organization and manuals")
;; (li (a ((href ,url-helpdesk-hints)) "Hints")
;; ": How to do things in Scheme")
)))
("teachpacks" "Teachpacks"
((ul (li (a ((href ,url-helpdesk-teachpacks-for-htdp))