From b94309538518abf99b79cd72291e03d9d587544f Mon Sep 17 00:00:00 2001 From: Paul Steckler Date: Fri, 20 Sep 2002 17:55:52 +0000 Subject: [PATCH] .. original commit: fd385a13472e28a0ebbdadf53cbeaa00dea9f062 --- collects/help/help.ss | 173 ++++++++++++++++++++---------------------- 1 file changed, 84 insertions(+), 89 deletions(-) diff --git a/collects/help/help.ss b/collects/help/help.ss index 38a6b3bd..3f9cd7c5 100644 --- a/collects/help/help.ss +++ b/collects/help/help.ss @@ -15,15 +15,15 @@ "help-desk" (current-command-line-arguments) (once-each - [("-n" "--no-browser") "Do not launch browser" + [("-n" "--no-browser") "Do not launch browser (ignored for PLT browser)" (set! launch-browser? #f)] - [("-x" "--external-connections") "Allow external connections" + [("-x" "--external-connections") "Allow external connections (ignored for PLT browser)" (set! external-connections? #t)] [("-i" "--iconize") "Iconize the control panel" (set! iconize? #t)] [("-q" "--quiet") "Don't show the control panel" (set! quiet? #t)] - [("-p" "--port") number "Use given port number" + [("-p" "--port") number "Use given port number (ignored for PLT browser)" (with-handlers ((void (lambda _ (error "Help Desk: expected exact integer for port")))) @@ -35,8 +35,12 @@ (define hd-cookie (start-help-server port external-connections?)) (define help-desk-port (hd-cookie->port hd-cookie)) - ; allow server startup time - (wait-for-connection help-desk-port) + (define internal-browser? (use-plt-browser?)) + + (if internal-browser? + (set! launch-browser? #t) ; always launch + ; allow server startup time + (wait-for-connection help-desk-port)) (when launch-browser? (with-handlers @@ -54,88 +58,79 @@ ; allow browser startup time (sleep 2))) - (if quiet? - (semaphore-wait (make-semaphore 0)) - (let* ([hd-frame% - (class frame% - (inherit show) - (field - [panel #f] - [main-sd-button #f] - [shutdown-dialog - (lambda () - (let* ([cb-frame (instantiate frame% () - (label "Confirm"))] - [vpanel (instantiate vertical-panel% () - (parent cb-frame))] - [msg (instantiate message% () - (label "Really shutdown Help Desk server?") - (parent vpanel))] - [hpanel (instantiate horizontal-panel% () - (parent vpanel) - (alignment '(center center)))] - [sd-button (instantiate button% () - (label "Shutdown") - (parent hpanel) - (callback - (lambda (b ev) - (send cb-frame show #f) - (send this show #f))))] - [no-sd-button (instantiate button% () - (label "Cancel") - (parent hpanel) - (callback - (lambda (b ev) - (send main-sd-button - enable #t) - (send cb-frame show #f))))]) - (send main-sd-button enable #f) - (send cb-frame center) - (send cb-frame show #t) - (send sd-button focus)))]) - (define/override can-close? - (lambda () (shutdown-dialog) #f)) - (super-instantiate ()) - (set! panel - (instantiate vertical-panel% () - (parent this))) - (instantiate message% () - (label (format "Help Desk server running on port ~a" - (hd-cookie->port hd-cookie))) - (parent panel)) - (instantiate button% () - (label "Help Desk Home") - (parent panel) - (min-width 100) - (callback - (lambda (b ev) - (help-desk-browser hd-cookie)))) - (set! main-sd-button - (instantiate button% () - (label "Shutdown Server") - (parent panel) - (min-width 100) - (callback (lambda (b ev) - (shutdown-dialog))))))] - [frame - (instantiate hd-frame% () - (label "PLT Help Desk") - (min-width 175) - (stretchable-width #f) - (stretchable-height #f))]) - (send frame center) - (send frame show #t) - (when iconize? - (send frame iconize #t))))) + (cond + [internal-browser? (void)] + [quiet? (semaphore-wait (make-semaphore 0))] + [else + (let* ([hd-frame% + (class frame% + (inherit show) + (field + [panel #f] + [main-sd-button #f] + [shutdown-dialog + (lambda () + (let* ([cb-frame (instantiate frame% () + (label "Confirm"))] + [vpanel (instantiate vertical-panel% () + (parent cb-frame))] + [msg (instantiate message% () + (label "Really shutdown Help Desk server?") + (parent vpanel))] + [hpanel (instantiate horizontal-panel% () + (parent vpanel) + (alignment '(center center)))] + [sd-button (instantiate button% () + (label "Shutdown") + (parent hpanel) + (callback + (lambda (b ev) + (send cb-frame show #f) + (send this show #f))))] + [no-sd-button (instantiate button% () + (label "Cancel") + (parent hpanel) + (callback + (lambda (b ev) + (send main-sd-button + enable #t) + (send cb-frame show #f))))]) + (send main-sd-button enable #f) + (send cb-frame center) + (send cb-frame show #t) + (send sd-button focus)))]) + (define/override can-close? + (lambda () (shutdown-dialog) #f)) + (super-instantiate ()) + (set! panel + (instantiate vertical-panel% () + (parent this))) + (instantiate message% () + (label (format "Help Desk server running on port ~a" + (hd-cookie->port hd-cookie))) + (parent panel)) + (instantiate button% () + (label "Help Desk Home") + (parent panel) + (min-width 100) + (callback + (lambda (b ev) + (help-desk-browser hd-cookie)))) + (set! main-sd-button + (instantiate button% () + (label "Shutdown Server") + (parent panel) + (min-width 100) + (callback (lambda (b ev) + (shutdown-dialog))))))] + [frame + (instantiate hd-frame% () + (label "PLT Help Desk") + (min-width 175) + (stretchable-width #f) + (stretchable-height #f))]) + (send frame center) + (send frame show #t) + (when iconize? + (send frame iconize #t)))])) - - - - - - - - - - -