diff --git a/collects/mred/private/wx/cocoa/clipboard.rkt b/collects/mred/private/wx/cocoa/clipboard.rkt index e64d9a5c..73a087db 100644 --- a/collects/mred/private/wx/cocoa/clipboard.rkt +++ b/collects/mred/private/wx/cocoa/clipboard.rkt @@ -100,4 +100,14 @@ (let ([i (tell (tell NSImage alloc) initWithPasteboard: (tell NSPasteboard generalPasteboard))]) (and i - (image->bitmap i))))))) + (image->bitmap i)))))) + + (define/public (set-bitmap-data bm timestamp) + (define image (bitmap->image bm)) + (atomically + (with-autorelease + (let ([pasteboard (tell NSPasteboard generalPasteboard)]) + (tell pasteboard clearContents) + (let ([copied-objects (tell NSArray arrayWithObject: image)]) + (tell pasteboard writeObjects: copied-objects) + (void))))))) diff --git a/collects/mred/private/wx/common/clipboard.rkt b/collects/mred/private/wx/common/clipboard.rkt index ca595fd7..1acafb95 100644 --- a/collects/mred/private/wx/common/clipboard.rkt +++ b/collects/mred/private/wx/common/clipboard.rkt @@ -1,5 +1,6 @@ #lang racket/base (require racket/class + (only-in racket/draw bitmap%) "../../syntax.rkt" "../platform.rkt" "local.rkt" @@ -61,7 +62,8 @@ (def/public (get-clipboard-bitmap [exact-integer? timestamp]) (send driver get-bitmap-data)) - (def/public-unimplemented set-clipboard-bitmap) + (def/public (set-clipboard-bitmap [bitmap% bm] [exact-integer? timestamp]) + (send driver set-bitmap-data bm timestamp)) (def/public (get-clipboard-data [string? type] [exact-integer? timestamp]) (send driver get-data type)) diff --git a/collects/mred/private/wx/gtk/clipboard.rkt b/collects/mred/private/wx/gtk/clipboard.rkt index 50c9c30b..2da85840 100644 --- a/collects/mred/private/wx/gtk/clipboard.rkt +++ b/collects/mred/private/wx/gtk/clipboard.rkt @@ -127,6 +127,8 @@ (_fun _GtkClipboard (_fpointer = string_request_received) _pointer -> _void)) (define-gtk gtk_clipboard_request_image (_fun _GtkClipboard (_fpointer = image_request_received) _pointer -> _void)) +(define-gtk gtk_clipboard_set_image + (_fun _GtkClipboard _GdkPixbuf -> _void)) ;; ---------------------------------------- @@ -295,6 +297,10 @@ (let-values ([(l backref) (make-request-backref)]) (gtk_clipboard_request_image cb backref) l)))) + + (define/public (set-bitmap-data bm timestamp) + (define pb (bitmap->pixbuf bm)) + (gtk_clipboard_set_image cb pb)) (super-new)) diff --git a/collects/mred/private/wx/win32/clipboard.rkt b/collects/mred/private/wx/win32/clipboard.rkt index e7b715f4..a2b4f51a 100644 --- a/collects/mred/private/wx/win32/clipboard.rkt +++ b/collects/mred/private/wx/win32/clipboard.rkt @@ -196,7 +196,17 @@ (begin0 (get-bitmap-from-clipboard) (CloseClipboard))))) - + + (define/public (set-bitmap-data bm timestamp) + (define h (bitmap->hbitmap bm)) + (set-cpointer-tag! h '(HBITMAP HANDLE)) + (atomically + (when (OpenClipboard clipboard-owner-hwnd) + (EmptyClipboard) + (SetClipboardData CF_BITMAP h) + (CloseClipboard) + (void)))) + (super-new))