suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gtk clipboard fixes

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-14 16:09:39 -06:00
parent af499e3039
commit ed2c685a73
1 changed files with 28 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/mred/private/wx/gtk/clipboard.rkt
View File

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