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)
closes PR 11357
This commit is contained in:
Robby Findler
parent
54d36dc22a
commit
5e51b7f335
|
|
@ -190,7 +190,8 @@
|
|||
forget-saved-bug-report
|
||||
record-saved-bug-report
|
||||
(struct teachpack-callbacks (get-names remove add))
|
||||
make-teachpack-callbacks))
|
||||
make-teachpack-callbacks
|
||||
add-search-help-desk-menu-item))
|
||||
|
||||
(define-signature drracket:frame-cm^
|
||||
(<%>
|
||||
|
|
|
|||
|
|
@ -764,6 +764,13 @@ If the namespace does not, they are colored the unbound color.
|
|||
start-selection
|
||||
end-selection)))))
|
||||
(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
|
||||
(+ 1 (inexact->exact (floor (send event get-x))))
|
||||
(+ 1 (inexact->exact (floor (send event get-y))))))]))))
|
||||
|
|
|
|||
|
|
@ -129,74 +129,78 @@ module browser threading seems wrong.
|
|||
(set! added? #t)
|
||||
(new separator-menu-item% [parent menu]))))])
|
||||
|
||||
(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)))))))))
|
||||
(add-search-help-desk-menu-item text menu event add-sep)
|
||||
|
||||
(when (is-a? text editor:basic<%>)
|
||||
(let-values ([(pos text) (send text get-pos/text event)])
|
||||
(when (and pos (is-a? text text%))
|
||||
(send text split-snip pos)
|
||||
(send text split-snip (+ pos 1))
|
||||
(let ([snip (send text find-snip pos 'after-or-none)])
|
||||
(when (or (is-a? snip image-snip%)
|
||||
(is-a? snip image-core:image%)
|
||||
(is-a? snip cache-image-snip%))
|
||||
(add-sep)
|
||||
(new menu-item%
|
||||
[parent menu]
|
||||
[label (string-constant save-image)]
|
||||
[callback
|
||||
(λ (_1 _2)
|
||||
(let ([fn (put-file #f
|
||||
(send text get-top-level-window)
|
||||
#f "untitled.png" "png")])
|
||||
(when fn
|
||||
(let ([kind (filename->kind fn)])
|
||||
(cond
|
||||
[kind
|
||||
(cond
|
||||
[(or (is-a? snip image-snip%)
|
||||
(is-a? snip cache-image-snip%))
|
||||
(send (send snip get-bitmap) save-file fn kind)]
|
||||
[else
|
||||
(image-core:save-image-as-bitmap snip fn kind)])]
|
||||
[else
|
||||
(message-box
|
||||
(string-constant drscheme)
|
||||
"Must choose a filename that ends with either .png, .jpg, .xbm, or .xpm")])))))]))))))
|
||||
(when (is-a? text editor:basic<%>)
|
||||
(let-values ([(pos text) (send text get-pos/text event)])
|
||||
(when (and pos (is-a? text text%))
|
||||
(send text split-snip pos)
|
||||
(send text split-snip (+ pos 1))
|
||||
(let ([snip (send text find-snip pos 'after-or-none)])
|
||||
(when (or (is-a? snip image-snip%)
|
||||
(is-a? snip image-core:image%)
|
||||
(is-a? snip cache-image-snip%))
|
||||
(add-sep)
|
||||
(new menu-item%
|
||||
[parent menu]
|
||||
[label (string-constant save-image)]
|
||||
[callback
|
||||
(λ (_1 _2)
|
||||
(let ([fn (put-file #f
|
||||
(send text get-top-level-window)
|
||||
#f "untitled.png" "png")])
|
||||
(when fn
|
||||
(let ([kind (filename->kind fn)])
|
||||
(cond
|
||||
[kind
|
||||
(cond
|
||||
[(or (is-a? snip image-snip%)
|
||||
(is-a? snip cache-image-snip%))
|
||||
(send (send snip get-bitmap) save-file fn kind)]
|
||||
[else
|
||||
(image-core:save-image-as-bitmap snip fn kind)])]
|
||||
[else
|
||||
(message-box
|
||||
(string-constant drscheme)
|
||||
"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)
|
||||
(let ([ext (filename-extension fn)])
|
||||
|
|
|
|||
|
|
@ -625,6 +625,23 @@ all of the names in the tools library, for use defining keybindings
|
|||
@racket[filename],
|
||||
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.
|
||||
})
|
||||
|
||||
|
||||
;
|
||||
;
|
||||
;
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user