53 lines
1.9 KiB
Scheme
53 lines
1.9 KiB
Scheme
(module click-forwarding-editor mzscheme
|
|
|
|
(require
|
|
(lib "class.ss")
|
|
(lib "contract.ss")
|
|
(lib "etc.ss")
|
|
(lib "mred.ss" "mred"))
|
|
|
|
(provide/contract
|
|
(click-forwarding-editor-mixin mixin-contract))
|
|
|
|
;; mixin to forward clicks to children snips within the editor
|
|
(define (click-forwarding-editor-mixin super%)
|
|
(class super%
|
|
(inherit get-snip-location global-to-local local-to-global
|
|
find-snip get-dc set-caret-owner)
|
|
|
|
;; on-event ((is-a?/c mouse-event%) . -> . void?)
|
|
;; overridden to give focus to child snips when clicked
|
|
(define/override (on-event event)
|
|
(if (memq (send event get-event-type)
|
|
'(left-down left-up middle-down middle-up right-down right-up))
|
|
(let ([snip (find-snip/global (send event get-x) (send event get-y))])
|
|
(if (is-a? snip snip%)
|
|
(forward-event snip event)
|
|
(super on-event event)))
|
|
(super on-event event)))
|
|
|
|
;; forward-event ((is-a?/c snip%) (is-a?/c mouse-event%) . -> . void?)
|
|
;; send the event to the snip
|
|
(define/private (forward-event snip event)
|
|
(let ([editorx (box 0)]
|
|
[editory (box 0)])
|
|
(get-snip-location snip editorx editory false)
|
|
(let ([x (box (unbox editorx))]
|
|
[y (box (unbox editory))])
|
|
(local-to-global x y)
|
|
(send snip on-event (get-dc) (unbox x) (unbox y)
|
|
(unbox editorx) (unbox editory) event)
|
|
(set-caret-owner snip 'display))))
|
|
|
|
;; find-snip/global (number? number? . -> . (union (is-a?/c snip%) false?))
|
|
;; finds the snip in the pasteboard that is at x y in the global display
|
|
(define/private (find-snip/global x y)
|
|
(let ([new-x (box x)]
|
|
[new-y (box y)])
|
|
(global-to-local new-x new-y)
|
|
(find-snip (unbox new-x) (unbox new-y))))
|
|
|
|
(super-instantiate ())
|
|
))
|
|
)
|