Index: package.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/package.lisp,v
retrieving revision 1.48
diff -u -r1.48 package.lisp
--- package.lisp	22 Feb 2005 03:14:26 -0000	1.48
+++ package.lisp	11 Mar 2005 15:49:16 -0000
@@ -1988,6 +1988,7 @@
    #:text-style-width
    ;; Text selection protocol
    #:selection-owner
+   #:selection-timestamp
    #:selection-event
    #:selection-clear-event
    #:selection-notify-event
Index: text-selection.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/text-selection.lisp,v
retrieving revision 1.5
diff -u -r1.5 text-selection.lisp
--- text-selection.lisp	27 Feb 2005 23:07:36 -0000	1.5
+++ text-selection.lisp	11 Mar 2005 15:49:16 -0000
@@ -244,7 +244,8 @@
                                            :sheet owner
                                            :selection :primary))))
       (when (bind-selection (port pane) pane (event-timestamp event))
-	(setf (selection-owner (port pane)) pane)))))
+	(setf (selection-owner (port pane)) pane)
+	(setf (selection-timestamp (port pane)) (event-timestamp event))))))
 
 (defun repaint-markings (pane old-markings new-markings)
   (let ((old-region (reduce #'region-union (mapcar #'(lambda (x) (marking-region pane x)) old-markings)
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	11 Mar 2005 15:49:16 -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	11 Mar 2005 15:49:16 -0000
@@ -165,7 +165,8 @@
    (design-cache :initform (make-hash-table :test #'eq))
    (pointer :reader port-pointer)
    (pointer-grab-sheet :accessor pointer-grab-sheet :initform nil)
-   (selection-owner :initform nil :accessor selection-owner)))
+   (selection-owner :initform nil :accessor selection-owner)
+   (selection-timestamp :initform nil :accessor selection-timestamp)))
 
 (defun parse-clx-server-path (path)
   (pop path)
@@ -1317,16 +1318,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)))
@@ -1379,7 +1382,8 @@
   (xlib:set-selection-owner
    (clx-port-display port)
    :primary nil time)
-  (setf (selection-owner port) nil))
+  (setf (selection-owner port) nil)
+  (setf (selection-timestamp port) nil))
 
 (defmethod request-selection ((port clx-port) requestor time)
   (xlib:convert-selection :primary :STRING requestor :bounce time))
@@ -1399,12 +1403,16 @@
 
 ;; 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?
+;;
+;; FIXME: per ICCCM we MUST support :MULTIPLE
 (defmethod send-selection ((port clx-port) (event clx-selection-request-event) string)
   (let ((requestor (selection-event-requestor event))
         (property  (selection-event-property event))
@@ -1421,28 +1429,55 @@
                      target
                      property)                     
              (xlib:send-event requestor
-                            :selection-notify nil
-                            :window requestor
-                            :selection :primary
-                            :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)))) ;; ...
+			      :selection-notify nil
+			      :window requestor
+			      :event-window requestor
+			      :selection :primary
+			      :target target
+			      :property property
+			      :time time)))
+      (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)
+	 (let* ((display (clx-port-display port))
+		(targets (mapcar (lambda (x) (xlib:intern-atom display x))
+				 '(:TARGETS :STRING :TEXT :UTF8_STRING
+				   :COMPOUND_TEXT :TIMESTAMP))))
+	   (xlib:change-property requestor property targets target 32))
+	 (send-event :target :TARGETS))
+	((:TIMESTAMP)
+	 (when (null (selection-timestamp port))
+	   (format *trace-output* "~&;; selection-timestamp is null!~%"))
+	 (xlib:change-property requestor property
+			       (list (selection-timestamp port))
+			       target 32)
+	 (send-event :target :TIMESTAMP))
+	(t
+	 (format *trace-output*
+		 "~&;; Warning, unhandled type \"~A\". ~
+                  Sending property NIL to target.~%" target)
+	 (send-event :target target :property nil))))
     (xlib:display-force-output (xlib:window-display requestor))))
