.
original commit: c85c594f1656670e83bcdd100437ef9479bc2764
This commit is contained in:
parent
99e47c14fd
commit
c464c0ecc3
|
@ -1,7 +1,63 @@
|
|||
(module help mzscheme
|
||||
(require (lib "startup-cm.ss" "framework"))
|
||||
|
||||
(install-cm "PLTHDCM" "PLTHDDEBUG")
|
||||
#|
|
||||
|
||||
This file contains all of the initialization of the Help Desk application.
|
||||
It is only loaded when Help Desk is run by itself (outside DrScheme).
|
||||
|
||||
|#
|
||||
|
||||
(module help mzscheme
|
||||
(require (lib "cmdline.ss")
|
||||
(lib "class.ss")
|
||||
(lib "unitsig.ss")
|
||||
(lib "framework.ss" "framework")
|
||||
(lib "external.ss" "browser")
|
||||
"bug-report.ss" ;; load now to init the preferences early
|
||||
"private/link.ss"
|
||||
"private/sig.ss"
|
||||
(lib "string-constant.ss" "string-constants")
|
||||
(lib "mred-sig.ss" "mred")
|
||||
(lib "mred.ss" "mred")
|
||||
(lib "tcp-sig.ss" "net")
|
||||
(lib "plt-installer-sig.ss" "setup")
|
||||
(lib "plt-installer.ss" "setup"))
|
||||
|
||||
;; start help desk for real
|
||||
(dynamic-require '(lib "help-app-main.ss" "help" "private") #f))
|
||||
(command-line
|
||||
"help-desk"
|
||||
(current-command-line-arguments))
|
||||
|
||||
(preferences:add-panel
|
||||
(list (string-constant font-prefs-panel-title))
|
||||
(lambda (panel)
|
||||
(let* ([hp (new horizontal-panel% (parent panel))]
|
||||
[size (make-object slider%
|
||||
(string-constant font-size)
|
||||
1
|
||||
72
|
||||
hp
|
||||
(lambda (size evt)
|
||||
(preferences:set 'framework:standard-style-list:font-size (send size get-value)))
|
||||
(preferences:get 'framework:standard-style-list:font-size))])
|
||||
(preferences:add-callback
|
||||
'framework:standard-style-list:font-size
|
||||
(lambda (p v) (send size set-value v)))
|
||||
hp)))
|
||||
(preferences:add-warnings-checkbox-panel)
|
||||
(install-help-browser-preference-panel)
|
||||
|
||||
;; for use by the bug report frame.
|
||||
;(namespace-set-variable-value! 'help-desk:frame-mixin (make-bug-report/help-desk-mixin 'the-hd-cookie))
|
||||
|
||||
(handler:current-create-new-window
|
||||
(lambda (filename)
|
||||
(let ([browser-frame '((hd-cookie-new-browser the-hd-cookie))])
|
||||
(when (and filename
|
||||
(file-exists? filename))
|
||||
(send (send (send browser-frame get-hyper-panel) get-canvas) goto-url
|
||||
(string-append "file://" filename)
|
||||
#f))
|
||||
browser-frame)))
|
||||
|
||||
(define-values/invoke-unit/sig gui^ help-desk@ #f setup:plt-installer^ mred^ net:tcp^)
|
||||
|
||||
(new-help-desk))
|
||||
|
Loading…
Reference in New Issue
Block a user