diff --git a/collects/help/help-desk-urls.ss b/collects/help/help-desk-urls.ss new file mode 100644 index 0000000000..df14cb4c0b --- /dev/null +++ b/collects/help/help-desk-urls.ss @@ -0,0 +1,3 @@ +(module help-desk-urls mzscheme + (require "servlets/private/url.ss") + (provide (all-from "servlets/private/url.ss"))) \ No newline at end of file diff --git a/collects/help/private/standard-urls.ss b/collects/help/private/standard-urls.ss index 2fd0eb51fa..a265140e52 100644 --- a/collects/help/private/standard-urls.ss +++ b/collects/help/private/standard-urls.ss @@ -3,6 +3,7 @@ (lib "dirs.ss" "setup") (lib "contract.ss") (lib "config.ss" "planet") + (lib "help-desk-urls.ss" "help") "../servlets/private/util.ss" "internal-hp.ss" "get-help-url.ss") @@ -77,10 +78,10 @@ ; sym, string assoc list (define hd-locations - `((hd-tour ,(get-help-url (build-path (find-doc-dir) "tour"))) - (release-notes ,(prefix-with-server "/servlets/release/notes.ss")) - (plt-license ,(prefix-with-server "/servlets/release/license.ss")) - (front-page ,(prefix-with-server "/servlets/home.ss")))) + `((hd-tour ,(format "~a/index.html" (get-help-url (build-path (find-doc-dir) "tour")))) + (release-notes ,url-helpdesk-release-notes) + (plt-license ,url-helpdesk-license) + (front-page ,url-helpdesk-home))) (define hd-location-syms (map car hd-locations)) diff --git a/collects/help/servlets/acknowledge.ss b/collects/help/servlets/acknowledge.ss deleted file mode 100644 index b852895052..0000000000 --- a/collects/help/servlets/acknowledge.ss +++ /dev/null @@ -1,17 +0,0 @@ -(module acknowledge mzscheme - (require (lib "acks.ss" "drscheme") - (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 "Acknowledgements" - #:bodies `((a ([name "acknowledgements"] [value "acknowledgements"])) - (h1 "Acknowledgements") - (p ,(get-general-acks)) - (p ,(get-translating-acks)))))))) diff --git a/collects/help/servlets/home.ss b/collects/help/servlets/home.ss index e3c16f68d4..da513feb91 100644 --- a/collects/help/servlets/home.ss +++ b/collects/help/servlets/home.ss @@ -97,11 +97,7 @@ (html-top initial-request) (left-items) right-header right-items)]))]))))) - - (define (br*) - (if (eq? (helpdesk-platform) 'external-browser) - '() - '((br) (br)))) + (define (left-items) `(-- -- -- -- -- @@ -176,9 +172,6 @@ `(,page-title ,url "" ,page-title))]) easy-pages)) - (define (make-header-text s) - (color-highlight `(h2 () ,s))) - ;; static subpages ;; - In ALPHABETICAL order (define easy-pages @@ -350,10 +343,10 @@ (a ([href ,url-external-planet]) "PLaneT") "."))) ;; was: /servlets/scheme/doc.ss ("documentation" "Documentation" - (,(make-header-text "How to use DrScheme") + (,(make-green-header-text "How to use DrScheme") (p (a ([href ,url-helpdesk-drscheme]) "DrScheme") " provides information about using the DrScheme development environment.") - ,(make-header-text "Languages and Libraries") + ,(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.") @@ -371,7 +364,7 @@ " 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-header-text "Searching") + ,(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") diff --git a/collects/help/servlets/private/html.ss b/collects/help/servlets/private/html.ss index dc32255a85..a21e238c30 100644 --- a/collects/help/servlets/private/html.ss +++ b/collects/help/servlets/private/html.ss @@ -6,6 +6,8 @@ (lib "etc.ss") (lib "kw.ss") (lib "port.ss") + "../../private/options.ss" + "util.ss" "url.ss") ;;; @@ -23,6 +25,18 @@ (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