diff --git a/collects/mred/private/wx/gtk/clipboard.rkt b/collects/mred/private/wx/gtk/clipboard.rkt index 075890b98f..f396badc0e 100644 --- a/collects/mred/private/wx/gtk/clipboard.rkt +++ b/collects/mred/private/wx/gtk/clipboard.rkt @@ -2,6 +2,7 @@ (require scheme/class scheme/foreign "../../syntax.rkt" + "../../lock.rkt" "../common/queue.rkt" "../common/local.rkt" "../common/bstr.rkt" @@ -41,7 +42,7 @@ (define-gtk gtk_selection_data_set (_fun _GtkSelectionData _GdkAtom _int - _ubyte + _bytes _int -> _void)) (define-gtk gtk_clipboard_wait_for_contents (_fun _GtkClipboard _GdkAtom -> (_or-null _GtkSelectionData))) @@ -62,7 +63,7 @@ (function-ptr get-data (_fun #:atomic? #t _GtkClipboard _GtkSelectionData _int _pointer -> _void))) (define (clear-owner cb self-box) - (send (ptr-ref self-box _scheme) replaced)) + (send (ptr-ref self-box _scheme) replaced self-box)) (define clear_owner (function-ptr clear-owner (_fun #:atomic? #t _GtkClipboard _pointer -> _void))) @@ -77,7 +78,7 @@ (if x-selection? (gdk_atom_intern "CLIPBOARD" #t) (gdk_atom_intern "PRIMARY" #t)))) - (define self-box (malloc-immobile-cell this)) + (define self-box #f) (define/public (get-client) client) @@ -107,25 +108,33 @@ (+ offset 1)))) (set! client c) (set! client-data all-data) - (gtk_clipboard_set_with_data cb - targets - (length types) - get_data - clear_owner - self-box) + + (atomically + (let ([this-box (malloc-immobile-cell this)]) + (set! self-box this-box) + (gtk_clipboard_set_with_data cb + targets + (length types) + get_data + clear_owner + this-box))) + (free target-strings))))) - (define/public (replaced) + (define/public (replaced s-box) ;; Called in Gtk event-dispatch thread --- atomically with respect ;; to any other thread - (let ([c client]) - (when c - (set! client #f) - (set! client-data #f) - (queue-event (send c get-client-eventspace) - (lambda () - (send c on-replaced)))))) - + (when (eq? s-box self-box) + (set! self-box #f) + (let ([c client]) + (when c + (set! client #f) + (set! client-data #f) + (queue-event (send c get-client-eventspace) + (lambda () + (send c on-replaced)))))) + (free-immobile-cell s-box)) + (define/public (provide-data i sel-data) ;; Called in Gtk event-dispatch thread --- atomically with respect ;; to any other thread @@ -150,7 +159,7 @@ (process (gtk_clipboard_wait_for_contents cb (gdk_atom_intern format #t))))) (define/public (get-text-data) - (gtk_clipboard_wait_for_text cb)) + (or (gtk_clipboard_wait_for_text cb) "")) (super-new))