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
|
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^
|
||||||
(<%>
|
(<%>
|
||||||
|
|
|
||||||
|
|
@ -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))))))]))))
|
||||||
|
|
|
||||||
|
|
@ -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))
|
(when (is-a? text editor:basic<%>)
|
||||||
(let* ([str (if (= end start)
|
(let-values ([(pos text) (send text get-pos/text event)])
|
||||||
(find-symbol
|
(when (and pos (is-a? text text%))
|
||||||
text
|
(send text split-snip pos)
|
||||||
(call-with-values
|
(send text split-snip (+ pos 1))
|
||||||
(λ ()
|
(let ([snip (send text find-snip pos 'after-or-none)])
|
||||||
(send text dc-location-to-editor-location
|
(when (or (is-a? snip image-snip%)
|
||||||
(send event get-x)
|
(is-a? snip image-core:image%)
|
||||||
(send event get-y)))
|
(is-a? snip cache-image-snip%))
|
||||||
(λ (x y)
|
(add-sep)
|
||||||
(send text find-position x y))))
|
(new menu-item%
|
||||||
(send text get-text start end))]
|
[parent menu]
|
||||||
;; almost the same code as "search-help-desk" in "rep.rkt"
|
[label (string-constant save-image)]
|
||||||
[l (send text get-canvas)]
|
[callback
|
||||||
[l (and l (send l get-top-level-window))]
|
(λ (_1 _2)
|
||||||
[l (and l (is-a? l -frame<%>) (send l get-definitions-text))]
|
(let ([fn (put-file #f
|
||||||
[l (and l (send l get-next-settings))]
|
(send text get-top-level-window)
|
||||||
[l (and l (drracket:language-configuration:language-settings-language l))]
|
#f "untitled.png" "png")])
|
||||||
[ctxt (and l (send l capability-value 'drscheme:help-context-term))]
|
(when fn
|
||||||
[name (and l (send l get-language-name))])
|
(let ([kind (filename->kind fn)])
|
||||||
(unless (string=? str "")
|
(cond
|
||||||
(add-sep)
|
[kind
|
||||||
(let ([short-str (shorten-str str 50)])
|
(cond
|
||||||
(make-object menu-item%
|
[(or (is-a? snip image-snip%)
|
||||||
(gui-utils:format-literal-label
|
(is-a? snip cache-image-snip%))
|
||||||
(string-constant search-help-desk-for)
|
(send (send snip get-bitmap) save-file fn kind)]
|
||||||
(if (equal? short-str str)
|
[else
|
||||||
str
|
(image-core:save-image-as-bitmap snip fn kind)])]
|
||||||
(string-append short-str "...")))
|
[else
|
||||||
menu
|
(message-box
|
||||||
(λ x (help-desk:help-desk str (list ctxt name)))))))))
|
(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)])
|
(void))))))
|
||||||
(when (and pos (is-a? text text%))
|
|
||||||
(send text split-snip pos)
|
(define (add-search-help-desk-menu-item text menu event [add-sep void])
|
||||||
(send text split-snip (+ pos 1))
|
(let* ([end (send text get-end-position)]
|
||||||
(let ([snip (send text find-snip pos 'after-or-none)])
|
[start (send text get-start-position)])
|
||||||
(when (or (is-a? snip image-snip%)
|
(unless (= 0 (send text last-position))
|
||||||
(is-a? snip image-core:image%)
|
(let* ([str (if (= end start)
|
||||||
(is-a? snip cache-image-snip%))
|
(find-symbol
|
||||||
(add-sep)
|
text
|
||||||
(new menu-item%
|
(call-with-values
|
||||||
[parent menu]
|
(λ ()
|
||||||
[label (string-constant save-image)]
|
(send text dc-location-to-editor-location
|
||||||
[callback
|
(send event get-x)
|
||||||
(λ (_1 _2)
|
(send event get-y)))
|
||||||
(let ([fn (put-file #f
|
(λ (x y)
|
||||||
(send text get-top-level-window)
|
(send text find-position x y))))
|
||||||
#f "untitled.png" "png")])
|
(send text get-text start end))]
|
||||||
(when fn
|
;; almost the same code as "search-help-desk" in "rep.rkt"
|
||||||
(let ([kind (filename->kind fn)])
|
[l (send text get-canvas)]
|
||||||
(cond
|
[l (and l (send l get-top-level-window))]
|
||||||
[kind
|
[l (and l (is-a? l -frame<%>) (send l get-definitions-text))]
|
||||||
(cond
|
[l (and l (send l get-next-settings))]
|
||||||
[(or (is-a? snip image-snip%)
|
[l (and l (drracket:language-configuration:language-settings-language l))]
|
||||||
(is-a? snip cache-image-snip%))
|
[ctxt (and l (send l capability-value 'drscheme:help-context-term))]
|
||||||
(send (send snip get-bitmap) save-file fn kind)]
|
[name (and l (send l get-language-name))])
|
||||||
[else
|
(unless (string=? str "")
|
||||||
(image-core:save-image-as-bitmap snip fn kind)])]
|
(add-sep)
|
||||||
[else
|
(let ([short-str (shorten-str str 50)])
|
||||||
(message-box
|
(make-object menu-item%
|
||||||
(string-constant drscheme)
|
(gui-utils:format-literal-label
|
||||||
"Must choose a filename that ends with either .png, .jpg, .xbm, or .xpm")])))))]))))))
|
(string-constant search-help-desk-for)
|
||||||
|
(if (equal? short-str str)
|
||||||
(void))))))
|
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)])
|
||||||
|
|
|
||||||
|
|
@ -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.
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user