From bc435dc640f7cead9e35e8911a57eaf032a233f5 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 29 Jul 2008 06:59:43 +0000 Subject: [PATCH] Use context queries based on language capabilities. svn: r10955 --- collects/drscheme/private/help-desk.ss | 8 +- collects/drscheme/private/rep.ss | 103 +++++++++---------------- collects/drscheme/private/unit.ss | 39 +++++----- 3 files changed, 59 insertions(+), 91 deletions(-) diff --git a/collects/drscheme/private/help-desk.ss b/collects/drscheme/private/help-desk.ss index b3ff09f57a..9482f39f75 100644 --- a/collects/drscheme/private/help-desk.ss +++ b/collects/drscheme/private/help-desk.ss @@ -66,12 +66,8 @@ (define (goto-plt-license) (send-main-page "license/index.html")) -(define (help-desk [key #f] #:module [mod #f] #:manual [man #f]) - (if (or key mod man) - (perform-search (string-append (or key "") - (if mod (format " L:~a" mod) "") - (if man (format " T:~a" man) ""))) - (send-main-page))) +(define (help-desk [key #f] [context #f]) + (if key (perform-search key context) (send-main-page))) ;; here for legacy code that should be removed (define (get-docs) '()) diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index 4f5c544e59..18fd1a5688 100644 --- a/collects/drscheme/private/rep.ss +++ b/collects/drscheme/private/rep.ss @@ -252,73 +252,44 @@ TODO (eq? fn-name stacktrace-runtime-name)))) (define drs-bindings-keymap (make-object keymap:aug-keymap%)) - - (let ([with-drs-frame - (λ (obj f) - (when (is-a? obj editor<%>) - (let ([canvas (send obj get-canvas)]) - (when canvas - (let ([frame (send canvas get-top-level-window)]) - (when (is-a? frame drscheme:unit:frame%) - (f frame)))))))]) - - (send drs-bindings-keymap add-function - "search-help-desk" + + (let* ([get-frame + (λ (obj) + (and (is-a? obj editor<%>) + (let ([canvas (send obj get-canvas)]) + (and canvas + (let ([frame (send canvas get-top-level-window)]) + (and (is-a? frame drscheme:unit:frame%) + frame))))))] + [add-drs-function + (λ (name f) + (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) - (with-drs-frame - obj - (λ (frame) - (cond - [(is-a? obj text%) - (let* ([start (send obj get-start-position)] - [end (send obj get-end-position)] - [str (if (= start end) - (drscheme:unit:find-symbol obj start) - (send obj get-text start end))]) - (if (equal? "" str) - (drscheme:help-desk:help-desk) - (let ([language (let ([canvas (send obj get-canvas)]) - (and canvas - (let ([tlw (send canvas get-top-level-window)]) - (and (is-a? tlw drscheme:unit:frame<%>) - (send (send tlw get-definitions-text) - get-next-settings)))))]) - (drscheme:help-desk:help-desk str #|!!!!!!|#))))] - [else - (drscheme:help-desk:help-desk)]))))) - - (send drs-bindings-keymap add-function - "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)))))) + (if (not (and (is-a? obj text%) (get-frame obj))) ; is `get-frame' needed? + (drscheme:help-desk:help-desk) + (let* ([start (send obj get-start-position)] + [end (send obj get-end-position)] + [str (if (= start end) + (drscheme:unit:find-symbol obj start) + (send obj get-text start end))]) + (if (or (not str) (equal? "" str)) + (drscheme:help-desk:help-desk) + (let* ([l (send obj get-canvas)] + [l (and l (send l get-top-level-window))] + [l (and l (is-a? l drscheme:unit:frame<%>) (send l get-definitions-text))] + [l (and l (send l get-next-settings))] + [l (and l (drscheme:language-configuration:language-settings-language l))] + [ctxt (and l (send l capability-value 'drscheme:help-context-term))] + [name (and l (send l get-language-name))]) + (drscheme:help-desk:help-desk + str (and ctxt (list ctxt name))))))))) + (add-drs-function "execute" (λ (frame) (send frame execute-callback))) + (add-drs-function "next-tab" (λ (frame) (send frame next-tab))) + (add-drs-function "prev-tab" (λ (frame) (send frame prev-tab))) + (add-drs-function "collapse" (λ (frame) (send frame collapse))) + (add-drs-function "split" (λ (frame) (send frame split)))) (send drs-bindings-keymap map-function "f5" "execute") (send drs-bindings-keymap map-function "f1" "search-help-desk") diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index 4c68fd7267..ed22fae71d 100644 --- a/collects/drscheme/private/unit.ss +++ b/collects/drscheme/private/unit.ss @@ -124,24 +124,25 @@ module browser threading seems wrong. (let* ([end (send text get-end-position)] [start (send text get-start-position)]) (unless (= 0 (send text last-position)) - (let ([str (if (= end start) - (find-symbol - text - (call-with-values - (λ () - (send text dc-location-to-editor-location - (send event get-x) - (send event get-y))) - (λ (x y) - (send text find-position x y)))) - (send text get-text start end))] - [language - (let ([canvas (send text get-canvas)]) - (and canvas - (let ([tlw (send canvas get-top-level-window)]) - (and (is-a? tlw -frame<%>) - (send (send tlw get-definitions-text) - get-next-settings)))))]) + (let* ([str (if (= end start) + (find-symbol + text + (call-with-values + (λ () + (send text dc-location-to-editor-location + (send event get-x) + (send event get-y))) + (λ (x y) + (send text find-position x y)))) + (send text get-text start end))] + ;; almost the same code as "search-help-desk" in "rep.ss" + [l (send text get-canvas)] + [l (and l (send l get-top-level-window))] + [l (and l (is-a? l -frame<%>) (send l get-definitions-text))] + [l (and l (send l get-next-settings))] + [l (and l (drscheme:language-configuration:language-settings-language l))] + [ctxt (and l (send l capability-value 'drscheme:help-context-term))] + [name (and l (send l get-language-name))]) (unless (string=? str "") (add-sep) (make-object menu-item% @@ -151,7 +152,7 @@ module browser threading seems wrong. str (- 200 (string-length (string-constant search-help-desk-for))))) menu - (λ x (help-desk:help-desk str #|!!!!|#))))))) + (λ x (help-desk:help-desk str (list ctxt name)))))))) (when (is-a? text editor:basic<%>) (let-values ([(pos text) (send text get-pos/text event)])