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

gtk: fix self X-selection handling

Browse Source 
original commit: 5c5e6039dfeaa178792d6a16dccbd84a39264d2f
This commit is contained in:
Matthew Flatt 2011-05-24 13:22:01 -06:00
parent ca2c0c2591
commit 0b6c46ab1f
1 changed files with 34 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -241,19 +241,47 @@
bstr
(bytes-length bstr))))))
(define/private (self-data data-format)
;; Due to the way we block for X-selection data and
;; provide only when the request arrives in the right
;; eventspace, we handle self-X-selection specially:
(and x-selection?
self-box
(let ([c client]
[types client-types]
[orig-types client-orig-types])
(for/or ([t (in-list types)]
[o (in-list orig-types)])
(and (equal? t data-format)
(let ([e (send c get-client-eventspace)])
(if (eq? (current-eventspace) e)
(send client get-data t)
(let ([s #f]
[done (make-semaphore)])
(parameterize ([current-eventspace e])
(queue-callback
(lambda ()
(set! s (send client get-data t))
(semaphore-post done))))
(sync/timeout 0.1 done)
s))))))))
(define/public (get-data data-format)
(let* ([data-format (if (equal? data-format "TEXT")
"UTF8_STRING"
data-format)]
[atom (gdk_atom_intern data-format #t)])
(or (self-data data-format)
(wait-request-backref
(atomically
(let-values ([(l backref) (make-request-backref)])
(gtk_clipboard_request_contents cb atom backref)
l)))))
l))))))
(define/public (get-text-data)
(or (wait-request-backref
(or (let ([s (self-data "UTF8_STRING")])
(and s (bytes->string/utf-8 s #\?)))
(wait-request-backref
(atomically
(let-values ([(l backref) (make-request-backref)])
(gtk_clipboard_request_text cb backref)