diff --git a/collects/mred/private/wx/cocoa/slider.rkt b/collects/mred/private/wx/cocoa/slider.rkt index c0e820e3..e735287d 100644 --- a/collects/mred/private/wx/cocoa/slider.rkt +++ b/collects/mred/private/wx/cocoa/slider.rkt @@ -8,6 +8,7 @@ "const.rkt" "utils.rkt" "window.rkt" + "queue.rkt" "../common/event.rkt" "../common/queue.rkt" "../common/freeze.rkt" @@ -158,6 +159,12 @@ (define/public (update-message [val (get-value)]) (tellv message-cocoa setTitleWithMnemonic: #:type _NSString (format "~a" val))) + (inherit get-cocoa-window) + (define/override (post-mouse-down) + ;; For some reason, dragging a slider disabled mouse-moved + ;; events for the window, so turn them back on: + (tellv (get-cocoa-window) setAcceptsMouseMovedEvents: #:type _BOOL #t)) + (define/override (maybe-register-as-child parent on?) (register-as-child parent on?))) diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index 409b6ef5..906c0349 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/collects/mred/private/wx/cocoa/window.rkt @@ -98,7 +98,10 @@ [wxb] [-a _void (mouseDown: [_id event]) (unless (do-mouse-event wxb event 'left-down #t #f #f 'right-down) - (super-tell #:type _void mouseDown: event))] + (super-tell #:type _void mouseDown: event) + (let ([wx (->wx wxb)]) + (when wx + (send wx post-mouse-down))))] [-a _void (mouseUp: [_id event]) (unless (do-mouse-event wxb event 'left-up #f #f #f 'right-up) (super-tell #:type _void mouseUp: event))] @@ -727,6 +730,8 @@ [caps-down #f]) #f)) + (define/public (post-mouse-down) (void)) + (define/public (on-char s) (void)) (define/public (on-event m) (void)) (define/public (queue-on-size) (void))