v201 stuff
original commit: 7003d9afc3b833c6e3015099e665ac8735fbb3db
This commit is contained in:
parent
d54711c88b
commit
c3cb1cc21c
|
@ -1,69 +1,40 @@
|
|||
#|
|
||||
TODO:
|
||||
* demonstrate setup-plt launcher
|
||||
* manuals as `doc' sub-collections?
|
||||
|#
|
||||
|
||||
(module help mzscheme
|
||||
(require (lib "class.ss")
|
||||
(lib "unitsig.ss")
|
||||
"startup-url.ss"
|
||||
"help-unit.ss"
|
||||
"help-sig.ss"
|
||||
"proxy-prefs.ss"
|
||||
(lib "string-constant.ss" "string-constants")
|
||||
(lib "framework.ss" "framework")
|
||||
(lib "framework-sig.ss" "framework")
|
||||
(lib "plt-installer.ss" "setup")
|
||||
(lib "plt-installer-sig.ss" "setup")
|
||||
(lib "mred-sig.ss" "mred")
|
||||
(lib "mred.ss" "mred"))
|
||||
|
||||
(preferences:add-editor-checkbox-panel)
|
||||
(preferences:add-warnings-checkbox-panel)
|
||||
;; don't call preferences:add-scheme-checkbox-panel
|
||||
;; here since those prefs don't really apply to Help Desk
|
||||
(add-proxy-prefs-panel)
|
||||
|
||||
(define (frame-mixin %)
|
||||
(class %
|
||||
(define/override (help-menu:about-string)
|
||||
(string-constant about-help-desk))
|
||||
(define/override (help-menu:about-callback i e)
|
||||
(message-box (string-constant about-help-desk)
|
||||
(format
|
||||
(string-constant help-desk-about-string)
|
||||
(version:version))
|
||||
this))
|
||||
(define/override (help-menu:create-about?) #t)
|
||||
(define/override (help-menu:after-about menu)
|
||||
(make-object menu-item% (string-constant help-on-help) menu
|
||||
(lambda (i e)
|
||||
(message-box
|
||||
(string-constant help-on-help)
|
||||
(string-constant help-on-help-details)
|
||||
this))))
|
||||
(super-instantiate ())))
|
||||
|
||||
(define (user-defined-doc-position x) #f)
|
||||
(require (lib "web-server.ss" "web-server")
|
||||
(lib "util.ss" "web-server")
|
||||
(lib "configuration.ss" "web-server")
|
||||
(lib "configuration-structures.ss" "web-server")
|
||||
(lib "server.ss" "help")
|
||||
(lib "browser.ss" "help"))
|
||||
|
||||
(require (lib "exit.ss" "doc" "help" "servlets" "private"))
|
||||
|
||||
(define hd-cookie (start-help-server))
|
||||
(define help-desk-port (hd-cookie->port hd-cookie))
|
||||
|
||||
(define exit-sem (make-semaphore 0))
|
||||
(set-box! exit-box (lambda () (semaphore-post exit-sem)))
|
||||
|
||||
; allow server startup time
|
||||
(let loop ()
|
||||
(with-handlers
|
||||
([void (lambda _ (sleep 1) (loop))])
|
||||
(let-values
|
||||
([(iport oport) (tcp-connect "127.0.0.1" help-desk-port)])
|
||||
(sleep 1)
|
||||
(close-output-port oport)
|
||||
(close-input-port iport))))
|
||||
|
||||
(help-desk-browser hd-cookie)
|
||||
; wait until shutdown
|
||||
(semaphore-wait/enable-break exit-sem))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; just in case drscheme hasn't been run before, we
|
||||
;; need a default for this preference.
|
||||
(preferences:set-default
|
||||
'drscheme:font-size
|
||||
(send (send (send (make-object text%)
|
||||
get-style-list)
|
||||
basic-style)
|
||||
get-size)
|
||||
(lambda (x) (and (number? x) (exact? x) (= x (floor x)))))
|
||||
|
||||
(define-values/invoke-unit/sig help^
|
||||
help@
|
||||
#f
|
||||
setup:plt-installer^
|
||||
mred^
|
||||
framework^
|
||||
(frame-mixin)
|
||||
help:doc-position^)
|
||||
|
||||
(new-help-frame startup-url))
|
||||
|
|
Loading…
Reference in New Issue
Block a user