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

add a menu item to the check syntax context-sensitive help that offers to search in help desk (just like the menu item that is there when check syntax is not running)

Browse Source 
closes PR 11357
This commit is contained in:
Robby Findler 2010-12-16 14:13:15 -06:00
parent 54d36dc22a
commit 5e51b7f335
4 changed files with 98 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/drracket/private/drsig.rkt
View File

@ -190,7 +190,8 @@
forget-saved-bug-report forget-saved-bug-report
record-saved-bug-report record-saved-bug-report
(struct teachpack-callbacks (get-names remove add)) (struct teachpack-callbacks (get-names remove add))
make-teachpack-callbacks)) make-teachpack-callbacks
add-search-help-desk-menu-item))
(define-signature drracket:frame-cm^ (define-signature drracket:frame-cm^
(<%> (<%>

7
collects/drracket/private/syncheck/gui.rkt
View File

@ -764,6 +764,13 @@ If the namespace does not, they are colored the unbound color.
start-selection start-selection
end-selection))))) end-selection)))))
(for-each (λ (f) (f menu)) add-menus) (for-each (λ (f) (f menu)) add-menus)
(drracket:unit:add-search-help-desk-menu-item
text
menu
event
(λ () (new separator-menu-item% [parent menu])))
(send (get-canvas) popup-menu menu (send (get-canvas) popup-menu menu
(+ 1 (inexact->exact (floor (send event get-x)))) (+ 1 (inexact->exact (floor (send event get-x))))
(+ 1 (inexact->exact (floor (send event get-y))))))])))) (+ 1 (inexact->exact (floor (send event get-y))))))]))))

136
collects/drracket/private/unit.rkt
View File

@ -129,74 +129,78 @@ module browser threading seems wrong.
(set! added? #t) (set! added? #t)
(new separator-menu-item% [parent menu]))))]) (new separator-menu-item% [parent menu]))))])
(let* ([end (send text get-end-position)] (add-search-help-desk-menu-item text menu event add-sep)
[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))]
;; almost the same code as "search-help-desk" in "rep.rkt"
[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 (drracket: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)
(let ([short-str (shorten-str str 50)])
(make-object menu-item%
(gui-utils:format-literal-label
(string-constant search-help-desk-for)
(if (equal? short-str str)
str
(string-append short-str "...")))
menu
(λ 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)])
(when (and pos (is-a? text text%)) (when (and pos (is-a? text text%))
(send text split-snip pos) (send text split-snip pos)
(send text split-snip (+ pos 1)) (send text split-snip (+ pos 1))
(let ([snip (send text find-snip pos 'after-or-none)]) (let ([snip (send text find-snip pos 'after-or-none)])
(when (or (is-a? snip image-snip%) (when (or (is-a? snip image-snip%)
(is-a? snip image-core:image%) (is-a? snip image-core:image%)
(is-a? snip cache-image-snip%)) (is-a? snip cache-image-snip%))
(add-sep) (add-sep)
(new menu-item% (new menu-item%
[parent menu] [parent menu]
[label (string-constant save-image)] [label (string-constant save-image)]
[callback [callback
(λ (_1 _2) (λ (_1 _2)
(let ([fn (put-file #f (let ([fn (put-file #f
(send text get-top-level-window) (send text get-top-level-window)
#f "untitled.png" "png")]) #f "untitled.png" "png")])
(when fn (when fn
(let ([kind (filename->kind fn)]) (let ([kind (filename->kind fn)])
(cond (cond
[kind [kind
(cond (cond
[(or (is-a? snip image-snip%) [(or (is-a? snip image-snip%)
(is-a? snip cache-image-snip%)) (is-a? snip cache-image-snip%))
(send (send snip get-bitmap) save-file fn kind)] (send (send snip get-bitmap) save-file fn kind)]
[else [else
(image-core:save-image-as-bitmap snip fn kind)])] (image-core:save-image-as-bitmap snip fn kind)])]
[else [else
(message-box (message-box
(string-constant drscheme) (string-constant drscheme)
"Must choose a filename that ends with either .png, .jpg, .xbm, or .xpm")])))))])))))) "Must choose a filename that ends with either .png, .jpg, .xbm, or .xpm")])))))]))))))
(void)))))) (void))))))
(define (add-search-help-desk-menu-item text menu event [add-sep void])
(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))]
;; almost the same code as "search-help-desk" in "rep.rkt"
[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 (drracket: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)
(let ([short-str (shorten-str str 50)])
(make-object menu-item%
(gui-utils:format-literal-label
(string-constant search-help-desk-for)
(if (equal? short-str str)
str
(string-append short-str "...")))
menu
(λ x (help-desk:help-desk str (list ctxt name))))
(void)))))))
(define (filename->kind fn) (define (filename->kind fn)
(let ([ext (filename-extension fn)]) (let ([ext (filename-extension fn)])

17
collects/drracket/tool-lib.rkt
View File

@ -625,6 +625,23 @@ all of the names in the tools library, for use defining keybindings
@racket[filename], @racket[filename],
or nothing if @racket[filename] is @racket[#f] or not supplied.}) or nothing if @racket[filename] is @racket[#f] or not supplied.})
(proc-doc/names
drracket:unit:add-search-help-desk-menu-item
(->* ((is-a?/c text%) (is-a?/c menu-item-container<%>) (is-a?/c mouse-event%)) ((-> any)) void?)
((text menu event)
((add-sep void)))
@{Assuming that @racket[event] represents a mouse click in @racket[text], this
adds a menu item to @racket[menu] that searches in Help Desk
for the text around the point where the click happened.
If there is only whitespace around the insertion point,
then no @racket[menu-item%]s are added, and
@racket[add-sep] is not called. If there is something to be
added, then @racket[add-sep] is called before the menu item is
created.
})
; ;
; ;
; ;