fix support for a string result from get-data' of clipboard-client%'

and properly report an error when the result from `get-data' is not
  allowed
 Closes PR 11821

original commit: d77c92d0878384024a3b00f6bfaa7fe3214493f6
This commit is contained in:
Matthew Flatt 2011-03-27 10:50:51 -06:00
parent 0bdfa9a121
commit 9f4be33c93
4 changed files with 41 additions and 17 deletions

View File

@ -63,13 +63,17 @@
owner: #f))
(set! client c)
(for ([type (in-list types)])
(let* ([bstr (send c get-data type)]
[data (tell NSData
dataWithBytes: #:type _bytes bstr
length: #:type _NSUInteger (bytes-length bstr))])
(tellv (tell NSPasteboard generalPasteboard)
setData: data
forType: #:type _NSString (map-type type))))))))
(let ([bstr (send c get-data type)])
(when bstr
(let* ([bstr (if (string? bstr)
(string->bytes/utf-8 bstr)
bstr)]
[data (tell NSData
dataWithBytes: #:type _bytes bstr
length: #:type _NSUInteger (bytes-length bstr))])
(tellv (tell NSPasteboard generalPasteboard)
setData: data
forType: #:type _NSString (map-type type))))))))))
(define/public (get-data-for-type type)
(log-error "didn't expect clipboard data request"))

View File

@ -11,7 +11,21 @@
get-the-clipboard
get-the-x-selection))
(defclass clipboard-client% object%
(define pre-client%
(class object%
(super-new)
(def/pubment (get-data [string? format])
(let ([d (inner #f get-data format)])
(when d
(unless (or (string? d) (bytes? d))
(raise-mismatch-error
'|get-data method of clipboard-client%|
"result is not #f, a string, or byte string: "
d)))
d))))
(defclass clipboard-client% pre-client%
(define types null)
(define es (current-eventspace))
(define/public (get-client-eventspace) es)
@ -22,7 +36,7 @@
types)
(def/public (add-type [string? str])
(set! types (cons (string->immutable-string str) types)))
(def/public (get-data [string? format])
(define/augride (get-data format)
#f)
(def/public (on-replaced)
(void))

View File

@ -227,16 +227,19 @@
(list-ref client-data i)
(constrained-reply (send client get-client-eventspace)
(lambda ()
(send client get-data
(list-ref client-orig-types i)))
(send client get-data
(list-ref client-orig-types i)))
#f))
#f)])
(when bstr
(gtk_selection_data_set sel-data
(gdk_atom_intern (list-ref client-types i) #t)
8
bstr
(bytes-length bstr)))))
(let ([bstr (if (string? bstr)
(string->bytes/utf-8 bstr)
bstr)])
(gtk_selection_data_set sel-data
(gdk_atom_intern (list-ref client-types i) #t)
8
bstr
(bytes-length bstr))))))
(define/public (get-data data-format)
(let* ([data-format (if (equal? data-format "TEXT")

View File

@ -126,7 +126,10 @@
(RegisterClipboardFormatW t)))]
[all-data (for/list ([t (in-list types)]
[t-id (in-list type-ids)])
(let ([d (send c get-data t)])
(let ([d (let ([d (send c get-data t)])
(if (string? d)
(string->bytes/utf-8 d)
d))])
(cond
[(equal? t-id CF_UNICODETEXT)
;; convert UTF-8 to UTF-16: