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

Use context queries based on language capabilities.

Browse Source 
svn: r10955
This commit is contained in:
Eli Barzilay 2008-07-29 06:59:43 +00:00
parent a871476756
commit bc435dc640
3 changed files with 59 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/drscheme/private/help-desk.ss
View File

@ -66,12 +66,8 @@
(define (goto-plt-license) (define (goto-plt-license)
(send-main-page "license/index.html")) (send-main-page "license/index.html"))
(define (help-desk [key #f] #:module [mod #f] #:manual [man #f]) (define (help-desk [key #f] [context #f])
(if (or key mod man) (if key (perform-search key context) (send-main-page)))
(perform-search (string-append (or key "")
(if mod (format " L:~a" mod) "")
(if man (format " T:~a" man) "")))
(send-main-page)))
;; here for legacy code that should be removed ;; here for legacy code that should be removed
(define (get-docs) '()) (define (get-docs) '())

101
collects/drscheme/private/rep.ss
View File

@ -253,72 +253,43 @@ TODO
(define drs-bindings-keymap (make-object keymap:aug-keymap%)) (define drs-bindings-keymap (make-object keymap:aug-keymap%))
(let ([with-drs-frame (let* ([get-frame
(λ (obj f) (λ (obj)
(when (is-a? obj editor<%>) (and (is-a? obj editor<%>)
(let ([canvas (send obj get-canvas)]) (let ([canvas (send obj get-canvas)])
(when canvas (and canvas
(let ([frame (send canvas get-top-level-window)]) (let ([frame (send canvas get-top-level-window)])
(when (is-a? frame drscheme:unit:frame%) (and (is-a? frame drscheme:unit:frame%)
(f frame)))))))]) frame))))))]
[add-drs-function
(send drs-bindings-keymap add-function (λ (name f)
"search-help-desk" (send drs-bindings-keymap add-function name
(λ (obj evt) (cond [(get-frame obj) => f]))))])
(send drs-bindings-keymap add-function "search-help-desk"
(λ (obj evt) (λ (obj evt)
(with-drs-frame (if (not (and (is-a? obj text%) (get-frame obj))) ; is `get-frame' needed?
obj (drscheme:help-desk:help-desk)
(λ (frame) (let* ([start (send obj get-start-position)]
(cond [end (send obj get-end-position)]
[(is-a? obj text%) [str (if (= start end)
(let* ([start (send obj get-start-position)] (drscheme:unit:find-symbol obj start)
[end (send obj get-end-position)] (send obj get-text start end))])
[str (if (= start end) (if (or (not str) (equal? "" str))
(drscheme:unit:find-symbol obj start) (drscheme:help-desk:help-desk)
(send obj get-text start end))]) (let* ([l (send obj get-canvas)]
(if (equal? "" str) [l (and l (send l get-top-level-window))]
(drscheme:help-desk:help-desk) [l (and l (is-a? l drscheme:unit:frame<%>) (send l get-definitions-text))]
(let ([language (let ([canvas (send obj get-canvas)]) [l (and l (send l get-next-settings))]
(and canvas [l (and l (drscheme:language-configuration:language-settings-language l))]
(let ([tlw (send canvas get-top-level-window)]) [ctxt (and l (send l capability-value 'drscheme:help-context-term))]
(and (is-a? tlw drscheme:unit:frame<%>) [name (and l (send l get-language-name))])
(send (send tlw get-definitions-text) (drscheme:help-desk:help-desk
get-next-settings)))))]) str (and ctxt (list ctxt name)))))))))
(drscheme:help-desk:help-desk str #|!!!!!!|#))))] (add-drs-function "execute" (λ (frame) (send frame execute-callback)))
[else (add-drs-function "next-tab" (λ (frame) (send frame next-tab)))
(drscheme:help-desk:help-desk)]))))) (add-drs-function "prev-tab" (λ (frame) (send frame prev-tab)))
(add-drs-function "collapse" (λ (frame) (send frame collapse)))
(send drs-bindings-keymap add-function (add-drs-function "split" (λ (frame) (send frame split))))
"execute"
(λ (obj evt)
(with-drs-frame
obj
(λ (frame)
(send frame execute-callback)))))
(send drs-bindings-keymap add-function
"next-tab"
(λ (obj evt)
(with-drs-frame
obj
(λ (frame) (send frame next-tab)))))
(send drs-bindings-keymap add-function
"prev-tab"
(λ (obj evt)
(with-drs-frame
obj
(λ (frame) (send frame prev-tab)))))
(send drs-bindings-keymap add-function
"collapse"
(λ (obj evt)
(with-drs-frame
obj
(λ (frame) (send frame collapse)))))
(send drs-bindings-keymap add-function
"split"
(λ (obj evt)
(with-drs-frame
obj
(λ (frame) (send frame split))))))
(send drs-bindings-keymap map-function "f5" "execute") (send drs-bindings-keymap map-function "f5" "execute")
(send drs-bindings-keymap map-function "f1" "search-help-desk") (send drs-bindings-keymap map-function "f1" "search-help-desk")

39
collects/drscheme/private/unit.ss
View File

@ -124,24 +124,25 @@ module browser threading seems wrong.
(let* ([end (send text get-end-position)] (let* ([end (send text get-end-position)]
[start (send text get-start-position)]) [start (send text get-start-position)])
(unless (= 0 (send text last-position)) (unless (= 0 (send text last-position))
(let ([str (if (= end start) (let* ([str (if (= end start)
(find-symbol (find-symbol
text text
(call-with-values (call-with-values
(λ () (λ ()
(send text dc-location-to-editor-location (send text dc-location-to-editor-location
(send event get-x) (send event get-x)
(send event get-y))) (send event get-y)))
(λ (x y) (λ (x y)
(send text find-position x y)))) (send text find-position x y))))
(send text get-text start end))] (send text get-text start end))]
[language ;; almost the same code as "search-help-desk" in "rep.ss"
(let ([canvas (send text get-canvas)]) [l (send text get-canvas)]
(and canvas [l (and l (send l get-top-level-window))]
(let ([tlw (send canvas get-top-level-window)]) [l (and l (is-a? l -frame<%>) (send l get-definitions-text))]
(and (is-a? tlw -frame<%>) [l (and l (send l get-next-settings))]
(send (send tlw get-definitions-text) [l (and l (drscheme:language-configuration:language-settings-language l))]
get-next-settings)))))]) [ctxt (and l (send l capability-value 'drscheme:help-context-term))]
[name (and l (send l get-language-name))])
(unless (string=? str "") (unless (string=? str "")
(add-sep) (add-sep)
(make-object menu-item% (make-object menu-item%
@ -151,7 +152,7 @@ module browser threading seems wrong.
str str
(- 200 (string-length (string-constant search-help-desk-for))))) (- 200 (string-length (string-constant search-help-desk-for)))))
menu menu
(λ x (help-desk:help-desk str #|!!!!|#))))))) (λ x (help-desk:help-desk str (list ctxt name))))))))
(when (is-a? text editor:basic<%>) (when (is-a? text editor:basic<%>)
(let-values ([(pos text) (send text get-pos/text event)]) (let-values ([(pos text) (send text get-pos/text event)])