21 lines
556 B
Racket
21 lines
556 B
Racket
#lang racket
|
|
|
|
(provide set-clipboard-bitmap)
|
|
|
|
(require racket/draw
|
|
ffi/unsafe
|
|
ffi/unsafe/objc
|
|
ffi/unsafe/atomic
|
|
mred/private/wx/cocoa/image)
|
|
|
|
(import-class NSPasteboard NSArray)
|
|
|
|
(define (set-clipboard-bitmap bitmap)
|
|
(start-atomic)
|
|
(let ([pasteboard (tell NSPasteboard generalPasteboard)])
|
|
(tell pasteboard clearContents)
|
|
(let ([copied-objects (tell NSArray arrayWithObject:
|
|
(bitmap->image bitmap))])
|
|
(tell pasteboard writeObjects: copied-objects)
|
|
(end-atomic))))
|