diff --git a/collects/help/launch.ss b/collects/help/help-desk-server.ss similarity index 55% rename from collects/help/launch.ss rename to collects/help/help-desk-server.ss index 2c83efdabf..24cbe81646 100644 --- a/collects/help/launch.ss +++ b/collects/help/help-desk-server.ss @@ -1,4 +1,4 @@ -;;; launch.ss +(module help-desk-server mzscheme ;; PURPOSE ;; This file launches a web-server serving an online @@ -8,23 +8,33 @@ ;; NOTES ;; The web-server uses the port given by internal-port -;; in "collects/help/private/internal-hp.ss". +;; in "private/options.ss" by default. + +;; Startpage: +;; http://localhost:8012/servlets/home.ss +;; (where 8012 is the port given by internal-port) -;; Startpage: -;; http://localhost:8000/servlets/home.ss -;; (where 8000 is the port given by internal-port) (require (lib "web-server.ss" "web-server") (lib "web-config-unit.ss" "web-server") "private/config.ss" - (only "private/internal-hp.ss" internal-host) - "private/options.ss") + "private/internal-hp.ss" + "private/options.ss" + (lib "cmdline.ss")) (helpdesk-platform 'external-browser) +(command-line + "help-desk-server" + (current-command-line-arguments) + (once-each + [("-p" "--port") port "port to run on" + (internal-port (string->number port))])) +(printf "launch>>>> ~s\n" (internal-port)) + ;; start the HelpDesk server, and store a shutdown (define shutdown - (serve/web-config@ config)) + (serve/web-config@ (make-config))) (printf "\nStart here: http://~a:~a/servlets/home.ss\n\n" internal-host (internal-port)) @@ -32,3 +42,5 @@ (printf "Press enter to shutdown.\n") (read-line) ;(shutdown) + +) diff --git a/collects/help/info.ss b/collects/help/info.ss index 68b0e27b5e..039cff4ae9 100644 --- a/collects/help/info.ss +++ b/collects/help/info.ss @@ -2,7 +2,7 @@ (module info (lib "infotab.ss" "setup") (define name "Help") (define doc.txt "doc.txt") - (define compile-subcollections + (define compile-subcollections '(("help" "private") ("help" "servlets") ("help" "servlets" "private") @@ -13,7 +13,9 @@ ("help" "servlets" "scheme" "misc"))) (define help-desk-message "Mr: (require (lib \"help-desk.ss\" \"help\"))") - (define mred-launcher-libraries (list "help.ss")) - (define mred-launcher-names (list "Help Desk")) + (define mred-launcher-libraries '("help.ss")) + (define mred-launcher-names '("Help Desk")) + (define mzscheme-launcher-libraries '("help-desk-server.ss")) + (define mzscheme-launcher-names '("Help Desk Server")) (define install-collection "installer.ss") (define compile-omit-files '("launch.ss"))) diff --git a/collects/help/private/config.ss b/collects/help/private/config.ss index 97aed40566..58c8a659bd 100644 --- a/collects/help/private/config.ss +++ b/collects/help/private/config.ss @@ -6,9 +6,9 @@ "internal-hp.ss" (lib "namespace.ss" "web-server" "configuration")) - (provide config) + (provide make-config) - (define config + (define (make-config) (let* ([build-normal-path (lambda args (normalize-path @@ -44,7 +44,7 @@ (mime-types "../../web-server/default-web-root/mime.types") (password-authentication "passwords"))))]) (configuration-table-sexpr->web-config@ - `((port ,internal-port) + `((port ,(internal-port)) (max-waiting 40) (initial-connection-timeout 30) (default-host-table diff --git a/collects/help/private/get-help-url.ss b/collects/help/private/get-help-url.ss index e1fd89886a..497b8c2c53 100644 --- a/collects/help/private/get-help-url.ss +++ b/collects/help/private/get-help-url.ss @@ -36,7 +36,7 @@ (λ (segments anchor) (format "http://~a:~a/servlets/static.ss/~a~a~a" internal-host - internal-port + (internal-port) host (apply string-append (map (λ (x) (format "/~a" (path->string x))) segments)) diff --git a/collects/help/private/gui.ss b/collects/help/private/gui.ss index f7ebcb7d3f..ac6b5f4b99 100644 --- a/collects/help/private/gui.ss +++ b/collects/help/private/gui.ss @@ -111,7 +111,7 @@ url] ;; one of the "collects" hosts: - [(and (equal? internal-port (url-port url)) + [(and (equal? (internal-port) (url-port url)) (ormap (lambda (host) (equal? host (url-host url))) doc-hosts)) @@ -160,7 +160,7 @@ url))] ;; one of the other internal hosts - [(and (equal? internal-port (url-port url)) + [(and (equal? (internal-port) (url-port url)) (is-internal-host? (url-host url))) url] @@ -194,7 +194,7 @@ (mixin (hyper-text<%> editor<%>) () (define/augment (url-allows-evaling? url) (and (is-internal-host? (url-host url)) - (equal? internal-port (url-port url)))) + (equal? (internal-port) (url-port url)))) (define show-sk? #t) diff --git a/collects/help/private/internal-hp.ss b/collects/help/private/internal-hp.ss index 468c84c912..4ae2ffb15c 100644 --- a/collects/help/private/internal-hp.ss +++ b/collects/help/private/internal-hp.ss @@ -2,7 +2,7 @@ (require (lib "dirs.ss" "setup") (lib "config.ss" "planet") "options.ss") - (provide (rename internal-port* internal-port) + (provide internal-port is-internal-host? internal-host collects-hosts collects-dirs doc-hosts doc-dirs @@ -25,11 +25,6 @@ ;; URLs.) (define internal-host "localhost") - ;; fake an internal-port binding (actually a parameter in options.ss) - (define-syntax internal-port* - (syntax-id-rules () - [(x . xs) ((internal-port) . xs)] - [x (internal-port)])) (define (is-internal-host? str) (member str all-internal-hosts)) diff --git a/collects/help/private/link.ss b/collects/help/private/link.ss index 9cd7527c7e..c7422410f5 100644 --- a/collects/help/private/link.ss +++ b/collects/help/private/link.ss @@ -27,7 +27,7 @@ (define-unit-from-context inst@ setup:plt-installer^) (define-unit-from-context real-tcp@ tcp^) - (define-unit-binding config@ config (import) (export web-config^)) + (define-unit-binding config@ (make-config) (import) (export web-config^)) (define-compound-unit/infer help-desk@ (import) diff --git a/collects/help/private/standard-urls.ss b/collects/help/private/standard-urls.ss index 3608eaec39..2fd0eb51fa 100644 --- a/collects/help/private/standard-urls.ss +++ b/collects/help/private/standard-urls.ss @@ -27,21 +27,21 @@ (format "~a/html/~a/index.htm" (base-docs-url) manual-name)) (define (prefix-with-server suffix) - (format "http://~a:~a~a" internal-host internal-port suffix)) + (format "http://~a:~a~a" internal-host (internal-port) suffix)) - (define results-url-prefix (format "http://~a:~a/servlets/results.ss?" internal-host internal-port)) + (define results-url-prefix (format "http://~a:~a/servlets/results.ss?" internal-host (internal-port))) (define flush-manuals-path "/servlets/results.ss?flush=yes") - (define flush-manuals-url (format "http://~a:~a~a" internal-host internal-port flush-manuals-path)) + (define flush-manuals-url (format "http://~a:~a~a" internal-host (internal-port) flush-manuals-path)) (define relative-results-url-prefix "/servlets/results.ss?") - (define home-page-url (format "http://~a:~a/servlets/home.ss" internal-host internal-port)) + (define home-page-url (format "http://~a:~a/servlets/home.ss" internal-host (internal-port))) (define (make-missing-manual-url coll name link) (format "http://~a:~a/servlets/missing-manual.ss?manual=~a&name=~a&link=~a" internal-host - internal-port + (internal-port) coll (uri-encode name) (uri-encode link))) diff --git a/collects/help/private/tcp-intercept.ss b/collects/help/private/tcp-intercept.ss index 19cc23b0a8..2630ec8e21 100644 --- a/collects/help/private/tcp-intercept.ss +++ b/collects/help/private/tcp-intercept.ss @@ -96,7 +96,7 @@ (define (gen-tcp-connect raw) (lambda (hostname-string port) (if (and (is-internal-host? hostname-string) - (equal? internal-port port)) + (equal? (internal-port) port)) (let-values ([(req-in req-out) (make-pipe)] [(resp-in resp-out) (make-pipe)]) (parameterize ([current-custodian (make-custodian)]) diff --git a/collects/help/servlets/private/url.ss b/collects/help/servlets/private/url.ss index b5b9433011..b46cf985af 100644 --- a/collects/help/servlets/private/url.ss +++ b/collects/help/servlets/private/url.ss @@ -4,8 +4,7 @@ (provide (all-defined)) (define url-helpdesk-root - (string-append - "http://" internal-host ":" (number->string internal-port) "/servlets/")) + (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")) @@ -65,4 +64,4 @@ (define url-helpdesk-tour (url-home-subpage "tour")) (define url-helpdesk-why-drscheme (url-home-subpage "why-drscheme")) - ) \ No newline at end of file + )