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)
(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) '())

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

@ -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")

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

@ -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)])