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

mflatt changes

Browse Source 
original commit: fb666c0959145cc057209a481b8e32b64592bcb6
This commit is contained in:
Paul Steckler 2002-07-15 21:51:39 +00:00
parent c8e0ffabc4
commit 6a82b47be1
1 changed files with 43 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
collects/help/help.ss
View File

@ -22,7 +22,7 @@
(set! launch-browser? #f)] (set! launch-browser? #f)]
[("-x" "--external-connections") "Allow external connections" [("-x" "--external-connections") "Allow external connections"
(set! external-connections? #t)] (set! external-connections? #t)]
[("-i" "--iconizer") "Iconize the control panel" [("-i" "--iconize") "Iconize the control panel"
(set! iconize? #t)] (set! iconize? #t)]
[("-p" "--port") number "Use given port number" [("-p" "--port") number "Use given port number"
(with-handlers (with-handlers
@ -55,24 +55,58 @@
(class frame% (class frame%
(inherit show) (inherit show)
(field (field
[panel #f]) [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)))])
(super-instantiate ()) (super-instantiate ())
(set! panel (set! panel
(instantiate vertical-panel% () (instantiate vertical-panel% ()
(parent this))) (parent this)))
(instantiate message% ()
(label (format "Help Desk server running on port ~a"
(hd-cookie->port hd-cookie)))
(parent panel))
(instantiate button% () (instantiate button% ()
(label "New browser") (label "Help Desk Home")
(parent panel) (parent panel)
(min-width 100) (min-width 100)
(callback (callback
(lambda (b ev) (lambda (b ev)
(help-desk-browser hd-cookie)))) (help-desk-browser hd-cookie))))
(instantiate button% () (set! main-sd-button
(label "Shutdown server") (instantiate button% ()
(parent panel) (label "Shutdown Server")
(min-width 100) (parent panel)
(callback (lambda (b ev) (min-width 100)
(send this show #f)))))) (callback (lambda (b ev)
(shutdown-dialog)))))))
(define frame (define frame
(instantiate hd-frame% () (instantiate hd-frame% ()