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
This commit is contained in:
parent
deab2ddede
commit
d77c92d087
|
@ -63,13 +63,17 @@
|
||||||
owner: #f))
|
owner: #f))
|
||||||
(set! client c)
|
(set! client c)
|
||||||
(for ([type (in-list types)])
|
(for ([type (in-list types)])
|
||||||
(let* ([bstr (send c get-data type)]
|
(let ([bstr (send c get-data type)])
|
||||||
|
(when bstr
|
||||||
|
(let* ([bstr (if (string? bstr)
|
||||||
|
(string->bytes/utf-8 bstr)
|
||||||
|
bstr)]
|
||||||
[data (tell NSData
|
[data (tell NSData
|
||||||
dataWithBytes: #:type _bytes bstr
|
dataWithBytes: #:type _bytes bstr
|
||||||
length: #:type _NSUInteger (bytes-length bstr))])
|
length: #:type _NSUInteger (bytes-length bstr))])
|
||||||
(tellv (tell NSPasteboard generalPasteboard)
|
(tellv (tell NSPasteboard generalPasteboard)
|
||||||
setData: data
|
setData: data
|
||||||
forType: #:type _NSString (map-type type))))))))
|
forType: #:type _NSString (map-type type))))))))))
|
||||||
|
|
||||||
(define/public (get-data-for-type type)
|
(define/public (get-data-for-type type)
|
||||||
(log-error "didn't expect clipboard data request"))
|
(log-error "didn't expect clipboard data request"))
|
||||||
|
|
|
@ -11,7 +11,21 @@
|
||||||
get-the-clipboard
|
get-the-clipboard
|
||||||
get-the-x-selection))
|
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 types null)
|
||||||
(define es (current-eventspace))
|
(define es (current-eventspace))
|
||||||
(define/public (get-client-eventspace) es)
|
(define/public (get-client-eventspace) es)
|
||||||
|
@ -22,7 +36,7 @@
|
||||||
types)
|
types)
|
||||||
(def/public (add-type [string? str])
|
(def/public (add-type [string? str])
|
||||||
(set! types (cons (string->immutable-string str) types)))
|
(set! types (cons (string->immutable-string str) types)))
|
||||||
(def/public (get-data [string? format])
|
(define/augride (get-data format)
|
||||||
#f)
|
#f)
|
||||||
(def/public (on-replaced)
|
(def/public (on-replaced)
|
||||||
(void))
|
(void))
|
||||||
|
|
|
@ -232,11 +232,14 @@
|
||||||
#f))
|
#f))
|
||||||
#f)])
|
#f)])
|
||||||
(when bstr
|
(when bstr
|
||||||
|
(let ([bstr (if (string? bstr)
|
||||||
|
(string->bytes/utf-8 bstr)
|
||||||
|
bstr)])
|
||||||
(gtk_selection_data_set sel-data
|
(gtk_selection_data_set sel-data
|
||||||
(gdk_atom_intern (list-ref client-types i) #t)
|
(gdk_atom_intern (list-ref client-types i) #t)
|
||||||
8
|
8
|
||||||
bstr
|
bstr
|
||||||
(bytes-length bstr)))))
|
(bytes-length bstr))))))
|
||||||
|
|
||||||
(define/public (get-data data-format)
|
(define/public (get-data data-format)
|
||||||
(let* ([data-format (if (equal? data-format "TEXT")
|
(let* ([data-format (if (equal? data-format "TEXT")
|
||||||
|
|
|
@ -126,7 +126,10 @@
|
||||||
(RegisterClipboardFormatW t)))]
|
(RegisterClipboardFormatW t)))]
|
||||||
[all-data (for/list ([t (in-list types)]
|
[all-data (for/list ([t (in-list types)]
|
||||||
[t-id (in-list type-ids)])
|
[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
|
(cond
|
||||||
[(equal? t-id CF_UNICODETEXT)
|
[(equal? t-id CF_UNICODETEXT)
|
||||||
;; convert UTF-8 to UTF-16:
|
;; convert UTF-8 to UTF-16:
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
(for-syntax scheme/base))
|
(for-syntax scheme/base))
|
||||||
|
|
||||||
(provide defclass defclass*
|
(provide defclass defclass*
|
||||||
def/public def/public-final def/override def/override-final define/top case-args
|
def/public def/pubment def/public-final def/override def/override-final define/top case-args
|
||||||
def/public-unimplemented define-unimplemented
|
def/public-unimplemented define-unimplemented
|
||||||
maybe-box? any? bool? nonnegative-real? make-or-false make-box make-list make-alts
|
maybe-box? any? bool? nonnegative-real? make-or-false make-box make-list make-alts
|
||||||
make-literal symbol-in integer-in real-in make-procedure
|
make-literal symbol-in integer-in real-in make-procedure
|
||||||
|
@ -25,6 +25,8 @@
|
||||||
|
|
||||||
(define-syntax (def/public stx)
|
(define-syntax (def/public stx)
|
||||||
#`(def/thing define/public #,stx))
|
#`(def/thing define/public #,stx))
|
||||||
|
(define-syntax (def/pubment stx)
|
||||||
|
#`(def/thing define/pubment #,stx))
|
||||||
(define-syntax (def/public-final stx)
|
(define-syntax (def/public-final stx)
|
||||||
#`(def/thing define/public-final #,stx))
|
#`(def/thing define/public-final #,stx))
|
||||||
(define-syntax (def/override stx)
|
(define-syntax (def/override stx)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user