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))
|
||||
(set! client c)
|
||||
(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
|
||||
dataWithBytes: #:type _bytes bstr
|
||||
length: #:type _NSUInteger (bytes-length bstr))])
|
||||
(tellv (tell NSPasteboard generalPasteboard)
|
||||
setData: data
|
||||
forType: #:type _NSString (map-type type))))))))
|
||||
forType: #:type _NSString (map-type type))))))))))
|
||||
|
||||
(define/public (get-data-for-type type)
|
||||
(log-error "didn't expect clipboard data request"))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -232,11 +232,14 @@
|
|||
#f))
|
||||
#f)])
|
||||
(when 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)))))
|
||||
(bytes-length bstr))))))
|
||||
|
||||
(define/public (get-data data-format)
|
||||
(let* ([data-format (if (equal? data-format "TEXT")
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
(for-syntax scheme/base))
|
||||
|
||||
(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
|
||||
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
|
||||
|
@ -25,6 +25,8 @@
|
|||
|
||||
(define-syntax (def/public stx)
|
||||
#`(def/thing define/public #,stx))
|
||||
(define-syntax (def/pubment stx)
|
||||
#`(def/thing define/pubment #,stx))
|
||||
(define-syntax (def/public-final stx)
|
||||
#`(def/thing define/public-final #,stx))
|
||||
(define-syntax (def/override stx)
|
||||
|
|
Loading…
Reference in New Issue
Block a user