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

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mred/private/wx/cocoa/clipboard.rkt
View File

@ -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"))

18
collects/mred/private/wx/common/clipboard.rkt
View File

@ -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))

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

@ -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")

5
collects/mred/private/wx/win32/clipboard.rkt
View File

@ -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: