Index: Backends/CLX/medium.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp,v retrieving revision 1.66 diff -u -r1.66 medium.lisp --- Backends/CLX/medium.lisp 17 Feb 2005 21:23:29 -0000 1.66 +++ Backends/CLX/medium.lisp 7 Mar 2005 12:48:26 -0000 @@ -690,7 +690,7 @@ ((xlib::index>= i src-end) i) (declare (type xlib:array-index i j)) - (setq char (xlib:char->card8 (char src i))) + (setq char (char-code (char src i))) (if (or (< char min-char-index) (> char max-char-index)) (return i) (setf (aref dst j) char))) @@ -701,7 +701,7 @@ i) (declare (type xlib:array-index i j)) (setq elt (elt src i)) - (when (characterp elt) (setq elt (xlib:char->card8 elt))) + (when (characterp elt) (setq elt (char-code elt))) (if (or (not (integerp elt)) (< elt min-char-index) (> elt max-char-index)) Index: Backends/CLX/port.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp,v retrieving revision 1.108 diff -u -r1.108 port.lisp --- Backends/CLX/port.lisp 27 Feb 2005 23:07:41 -0000 1.108 +++ Backends/CLX/port.lisp 7 Mar 2005 12:48:26 -0000 @@ -1317,16 +1317,18 @@ ;; :TEXT, :STRING ;; ;; :UTF8_STRING -;; As seen from xterm [make that the prefered encoding] +;; As seen from xterm [make that the preferred encoding] ;; ;; :COMPOUND_TEXT ;; Perhaps relatively easy to produce, hard to grok. ;; +;; :TARGETS +;; Clients want legitimately to find out what we support. ;;; Utilities -(defun utf-8-encode (code-points) +(defun utf8-string-encode (code-points) (let ((res (make-array (length code-points) :adjustable t :fill-pointer 0))) @@ -1399,10 +1401,12 @@ ;; Incredibly crappy broken unportable Latin 1 encoder which should be ;; replaced by various implementation-specific versions. -(defun latin1-encode (string) - (delete-if (lambda (x) (or (< x 0) - (> x 255))) - (map 'vector #'char-code string))) +(flet ((latin1-code-p (x) + (not (or (< x 9) (< 10 x 32) (< #x7f x #xa0) (> x 255))))) + (defun string-encode (string) + (delete-if-not #'latin1-code-p (map 'vector #'char-code string))) + (defun exactly-encodable-as-string-p (string) + (every #'latin1-code-p (map 'vector #'char-code string)))) ;; TODO: INCR property? (defmethod send-selection ((port clx-port) (event clx-selection-request-event) string) @@ -1427,22 +1431,45 @@ :target target :property property :time time))) - (cond ((member target '(:UTF8_STRING :TEXT)) - (xlib:change-property requestor property - (utf-8-encode - (concatenate 'vector (map 'vector #'char-code string))) - :UTF8_STRING - 8) - (send-event :target :UTF8_STRING)) - ((member target '(:STRING :COMPOUND_TEXT)) - (xlib:change-property requestor property - (latin1-encode string) - :COMPOUND_TEXT - 8) - (send-event :target :COMPOUND_TEXT)) - (t - (format *trace-output* - "~&;; Warning, unhandled type \"~A\". Trying to send as UTF8_STRING.~%" - target) - (send-event :target :UTF8_STRING :property nil)))) ;; ... + (case target + ((:UTF8_STRING) + (xlib:change-property requestor property + (utf8-string-encode + (map 'vector #'char-code string)) + :UTF8_STRING 8) + (send-event :target :UTF8_STRING)) + ((:STRING :COMPOUND_TEXT) + (xlib:change-property requestor property + (string-encode string) + target 8) + (send-event :target target)) + ((:TEXT) + (cond + ((exactly-encodable-as-string-p string) + (xlib:change-property requestor property + (string-encode string) + :STRING 8) + (send-event :target :STRING)) + (t + (xlib:change-property requestor property + (utf8-string-encode + (map 'vector #'char-code string)) + :UTF8_STRING 8) + (send-event :target :UTF8_STRING)))) + ((:TARGETS) + (xlib:change-property requestor property + '(:TARGETS + :STRING :TEXT + :UTF8_STRING :COMPOUND_TEXT) + target 32 + :transform (lambda (x) + (xlib:intern-atom + (xlib:window-display requestor) + x))) + (send-event :target :TARGETS)) + (t + (format *trace-output* + "~&;; Warning, unhandled type \"~A\". Trying to send as UTF8_STRING.~%" + target) + (send-event :target :UTF8_STRING :property nil)))) ;; ... (xlib:display-force-output (xlib:window-display requestor))))