[mcclim-devel] Copying text to clipboard loops displaying messages to Konsole

[Christophe Rhodes]

Paolo Amoroso <amoroso at mclink.it> writes:

> When I copy some text with Shift-left-click from the CLIM Listener for
> later copying somewhere else, I get an infinite loop that displays
> messages (all identical) like this to the KDE Konsole from which I
> have started the Listener:

If it's still not working for you, could you please try the attached
patch?

If this fails to work correctly, could you provide me with a few more
details about your setup?  You're working in Konsole -- could you tell
me also what your LANG and LC_ALL settings are, and what the following
program produces?

#include <stdlib.h>
#include <langinfo.h>

int main () {
  printf("CODESET: %s\n", nl_langinfo(CODESET));
}

-------------- next part --------------
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))))
-------------- next part --------------

Thanks,

Christophe