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

..

Browse Source 
original commit: fd385a13472e28a0ebbdadf53cbeaa00dea9f062
This commit is contained in:
Paul Steckler 2002-09-20 17:55:52 +00:00
parent 117050fbc2
commit b943095385
1 changed files with 84 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

173
collects/help/help.ss
View File

@ -15,15 +15,15 @@
"help-desk" "help-desk"
(current-command-line-arguments) (current-command-line-arguments)
(once-each (once-each
[("-n" "--no-browser") "Do not launch browser" [("-n" "--no-browser") "Do not launch browser (ignored for PLT browser)"
(set! launch-browser? #f)] (set! launch-browser? #f)]
[("-x" "--external-connections") "Allow external connections" [("-x" "--external-connections") "Allow external connections (ignored for PLT browser)"
(set! external-connections? #t)] (set! external-connections? #t)]
[("-i" "--iconize") "Iconize the control panel" [("-i" "--iconize") "Iconize the control panel"
(set! iconize? #t)] (set! iconize? #t)]
[("-q" "--quiet") "Don't show the control panel" [("-q" "--quiet") "Don't show the control panel"
(set! quiet? #t)] (set! quiet? #t)]
[("-p" "--port") number "Use given port number" [("-p" "--port") number "Use given port number (ignored for PLT browser)"
(with-handlers (with-handlers
((void (lambda _ ((void (lambda _
(error "Help Desk: expected exact integer for port")))) (error "Help Desk: expected exact integer for port"))))
@ -35,8 +35,12 @@
(define hd-cookie (start-help-server port external-connections?)) (define hd-cookie (start-help-server port external-connections?))
(define help-desk-port (hd-cookie->port hd-cookie)) (define help-desk-port (hd-cookie->port hd-cookie))
; allow server startup time (define internal-browser? (use-plt-browser?))
(wait-for-connection help-desk-port)
(if internal-browser?
(set! launch-browser? #t) ; always launch
; allow server startup time
(wait-for-connection help-desk-port))
(when launch-browser? (when launch-browser?
(with-handlers (with-handlers
@ -54,88 +58,79 @@
; allow browser startup time ; allow browser startup time
(sleep 2))) (sleep 2)))
(if quiet? (cond
(semaphore-wait (make-semaphore 0)) [internal-browser? (void)]
(let* ([hd-frame% [quiet? (semaphore-wait (make-semaphore 0))]
(class frame% [else
(inherit show) (let* ([hd-frame%
(field (class frame%
[panel #f] (inherit show)
[main-sd-button #f] (field
[shutdown-dialog [panel #f]
(lambda () [main-sd-button #f]
(let* ([cb-frame (instantiate frame% () [shutdown-dialog
(label "Confirm"))] (lambda ()
[vpanel (instantiate vertical-panel% () (let* ([cb-frame (instantiate frame% ()
(parent cb-frame))] (label "Confirm"))]
[msg (instantiate message% () [vpanel (instantiate vertical-panel% ()
(label "Really shutdown Help Desk server?") (parent cb-frame))]
(parent vpanel))] [msg (instantiate message% ()
[hpanel (instantiate horizontal-panel% () (label "Really shutdown Help Desk server?")
(parent vpanel) (parent vpanel))]
(alignment '(center center)))] [hpanel (instantiate horizontal-panel% ()
[sd-button (instantiate button% () (parent vpanel)
(label "Shutdown") (alignment '(center center)))]
(parent hpanel) [sd-button (instantiate button% ()
(callback (label "Shutdown")
(lambda (b ev) (parent hpanel)
(send cb-frame show #f) (callback
(send this show #f))))] (lambda (b ev)
[no-sd-button (instantiate button% () (send cb-frame show #f)
(label "Cancel") (send this show #f))))]
(parent hpanel) [no-sd-button (instantiate button% ()
(callback (label "Cancel")
(lambda (b ev) (parent hpanel)
(send main-sd-button (callback
enable #t) (lambda (b ev)
(send cb-frame show #f))))]) (send main-sd-button
(send main-sd-button enable #f) enable #t)
(send cb-frame center) (send cb-frame show #f))))])
(send cb-frame show #t) (send main-sd-button enable #f)
(send sd-button focus)))]) (send cb-frame center)
(define/override can-close? (send cb-frame show #t)
(lambda () (shutdown-dialog) #f)) (send sd-button focus)))])
(super-instantiate ()) (define/override can-close?
(set! panel (lambda () (shutdown-dialog) #f))
(instantiate vertical-panel% () (super-instantiate ())
(parent this))) (set! panel
(instantiate message% () (instantiate vertical-panel% ()
(label (format "Help Desk server running on port ~a" (parent this)))
(hd-cookie->port hd-cookie))) (instantiate message% ()
(parent panel)) (label (format "Help Desk server running on port ~a"
(instantiate button% () (hd-cookie->port hd-cookie)))
(label "Help Desk Home") (parent panel))
(parent panel) (instantiate button% ()
(min-width 100) (label "Help Desk Home")
(callback (parent panel)
(lambda (b ev) (min-width 100)
(help-desk-browser hd-cookie)))) (callback
(set! main-sd-button (lambda (b ev)
(instantiate button% () (help-desk-browser hd-cookie))))
(label "Shutdown Server") (set! main-sd-button
(parent panel) (instantiate button% ()
(min-width 100) (label "Shutdown Server")
(callback (lambda (b ev) (parent panel)
(shutdown-dialog))))))] (min-width 100)
[frame (callback (lambda (b ev)
(instantiate hd-frame% () (shutdown-dialog))))))]
(label "PLT Help Desk") [frame
(min-width 175) (instantiate hd-frame% ()
(stretchable-width #f) (label "PLT Help Desk")
(stretchable-height #f))]) (min-width 175)
(send frame center) (stretchable-width #f)
(send frame show #t) (stretchable-height #f))])
(when iconize? (send frame center)
(send frame iconize #t))))) (send frame show #t)
(when iconize?
(send frame iconize #t)))]))