made f1 work in drscheme, fixed a few other bugs

svn: r7781
This commit is contained in:
Robby Findler 2007-11-20 04:52:45 +00:00
parent 0e5aa22a9d
commit 1f81a98987
2 changed files with 89 additions and 85 deletions

View File

@ -1,6 +1,6 @@
#lang scheme/unit #lang scheme/unit
(require (lib "string-constant.ss" "string-constants")
(require (lib "string-constant.ss" "string-constants")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "external.ss" "browser") (lib "external.ss" "browser")
(lib "bug-report.ss" "help") (lib "bug-report.ss" "help")
@ -8,18 +8,17 @@
(lib "framework.ss" "framework") (lib "framework.ss" "framework")
(lib "class.ss") (lib "class.ss")
(lib "list.ss") (lib "list.ss")
(lib "search.ss" "help")
"drsig.ss") "drsig.ss")
(import [prefix drscheme:frame: drscheme:frame^]
(import [prefix drscheme:frame: drscheme:frame^]
[prefix drscheme:language-configuration: drscheme:language-configuration/internal^]) [prefix drscheme:language-configuration: drscheme:language-configuration/internal^])
(export drscheme:help-desk^) (export drscheme:help-desk^)
(define (-add-help-desk-font-prefs b) '(add-help-desk-font-prefs b)) (define (-add-help-desk-font-prefs b) '(add-help-desk-font-prefs b))
;; : -> string ;; : -> string
(define (get-computer-language-info) (define (get-computer-language-info)
(let* ([language/settings (preferences:get (let* ([language/settings (preferences:get
drscheme:language-configuration:settings-preferences-symbol)] drscheme:language-configuration:settings-preferences-symbol)]
[language (drscheme:language-configuration:language-settings-language [language (drscheme:language-configuration:language-settings-language
@ -32,9 +31,9 @@
(send language get-language-position) (send language get-language-position)
(send language marshall-settings settings))))) (send language marshall-settings settings)))))
(set-bug-report-info! "Computer Language" get-computer-language-info) (set-bug-report-info! "Computer Language" get-computer-language-info)
(define lang-message% (define lang-message%
(class canvas% (class canvas%
(init-field button-release font) (init-field button-release font)
(define/override (on-event evt) (define/override (on-event evt)
@ -65,17 +64,19 @@
(send dc draw-text dots (- cw dw) (- (/ ch 2) (/ th 2)))])))) (send dc draw-text dots (- cw dw) (- (/ ch 2) (/ th 2)))]))))
(super-new))) (super-new)))
(define (goto-manual-link a b) (error 'goto-maual-link "~s ~s" a b)) (define (goto-manual-link a b) (error 'goto-maual-link "~s ~s" a b))
(define (goto-hd-location b) (error 'goto-hd-location "~s" b)) (define (goto-hd-location b) (error 'goto-hd-location "~s" b))
(define (goto-help manual link) (goto-manual-link manual link)) (define (goto-help manual link) (goto-manual-link manual link))
(define (goto-tour) (goto-hd-location 'hd-tour)) (define (goto-tour) (goto-hd-location 'hd-tour))
(define (goto-release-notes) (goto-hd-location 'release-notes)) (define (goto-release-notes) (goto-hd-location 'release-notes))
(define (goto-plt-license) (goto-hd-location 'plt-license)) (define (goto-plt-license) (goto-hd-location 'plt-license))
(define (get-docs) (error 'help-desk.ss "get-docs")) (define (get-docs)
;(error 'help-desk.ss "get-docs")
'())
(define help-desk (define help-desk
(case-lambda (case-lambda
[() (void)] [() (void)]
[(key) (help-desk key #f)] [(key) (help-desk key #f)]
@ -83,4 +84,5 @@
[(key lucky? type) (help-desk key lucky? type 'contains)] [(key lucky? type) (help-desk key lucky? type 'contains)]
[(key lucky? type mode) (help-desk key lucky? type mode #f)] [(key lucky? type mode) (help-desk key lucky? type mode #f)]
[(key lucky? type mode language) [(key lucky? type mode language)
(generate-search-results (list key))
(void)])) (void)]))

View File

@ -7,9 +7,11 @@
scribble/basic scribble/basic
scribble/manual scribble/manual
(prefix-in scheme: scribble/scheme) (prefix-in scheme: scribble/scheme)
browser/external) browser/external
mzlib/contract)
(provide generate-search-results) (provide/contract
[generate-search-results (-> (listof string?) void?)])
(define (make-extra-content desc) (define (make-extra-content desc)
;; Use `desc' to provide more details on the link: ;; Use `desc' to provide more details on the link: