Subject: cl-clx-sbcl is not 8-bit clean in presence of SB-UNICODE
Package: cl-clx-sbcl
Version: 0.7.1-1
Severity: important
Tags: patch

*** Please type your report below this line ***
cl-clx-sbcl assumes that BASE-CHAR is an 8-bit character.
This isn't true with sbcl when compiled with feature SB-UNICODE (which is
the default for sbcl in general and the case for debian's sbcl package).
Thus, cl-clx-sbcl applications (such as stumpwm) will crash when X communicates
8-bit-unclean strings to it (such as 7-bit-unclean window titles).
The attached patch solves this issue by using CHARACTER and asserting
that the code-char is 8-bit instead of using BASE-CHAR.

-- System Information:
Debian Release: testing/unstable
  APT prefers unstable
  APT policy: (500, 'unstable'), (500, 'testing')
Architecture: i386 (i686)
Shell:  /bin/sh linked to /bin/bash
Kernel: Linux 2.6.13-xanadu
Locale: [EMAIL PROTECTED], [EMAIL PROTECTED] (charmap=ISO-8859-15)

Versions of packages cl-clx-sbcl depends on:
ii  cl-asdf                       1.86-5     Another System Definition Facility
ii  common-lisp-controller        4.20       This is a Common Lisp source and c

Versions of packages cl-clx-sbcl recommends:
ii  sbcl                         1:0.9.6.0-2 A development environment for Comm

-- no debconf information

[ François-René ÐVB Rideau | Reflection&Cybernethics | http://fare.tunes.org ]
-- Question authority!
-- Yeah, says who?
diff -urN /home/fare/clx.orig/clx.lisp clx/clx.lisp
--- /home/fare/clx.orig/clx.lisp	2005-07-14 09:24:45.000000000 -0400
+++ clx/clx.lisp	2005-11-08 17:23:31.000000000 -0500
@@ -173,6 +173,12 @@
 (deftype base-char ()
   'string-char)
 
+#-(and sbcl sb-unicode)
+(deftype char8 () 'base-char)
+#+(and sbcl sb-unicode)
+(deftype char8 () 'character) ;;; could be `(member ,@(loop for i below 256 collect (code-char i)))
+
+
 ; Note that we are explicitly using a different rgb representation than what
 ; is actually transmitted in the protocol.
 
diff -urN /home/fare/clx.orig/dependent.lisp clx/dependent.lisp
--- /home/fare/clx.orig/dependent.lisp	2005-10-04 04:01:12.000000000 -0400
+++ clx/dependent.lisp	2005-11-08 17:27:22.000000000 -0500
@@ -800,15 +800,16 @@
 			 #-Genera
 			 (progn
   			   (defun char->card8 (char)
-			     (declare (type base-char char))
+			     (declare (type char8 char))
 			     #.(declare-buffun)
+			     (assert (> 256 (char-code char)))
 			     (the card8 (aref (the (simple-array card8 (*))
 						   *char-to-card8-translation-table*)
 					      (the array-index (char-code char)))))
 			   (defun card8->char (card8)
 			     (declare (type card8 card8))
 			     #.(declare-buffun)
-			     (the base-char
+			     (the char8
 				  (or (aref (the simple-vector *card8-to-char-translation-table*)
 					    card8)
 				      (error "Invalid CHAR code ~D." card8))))
@@ -842,13 +843,13 @@
 		     (t
 		      `(progn
 			 (defun char->card8 (char)
-			   (declare (type base-char char))
+			   (declare (type char8 char))
 			   #.(declare-buffun)
 			   (the card8 (char-code char)))
 			 (defun card8->char (card8)
 			   (declare (type card8 card8))
 			   #.(declare-buffun)
-			   (the base-char (code-char card8)))
+			   (the char8 (code-char card8)))
 			 ))))))
   (char-translators))
 
@@ -1180,7 +1181,7 @@
   (declare (ignore whostate))
   (declare (type function predicate))
   (let* ((pid (current-process))
-	 (last (gethash  pid *process-conditions*))
+	 (last (gethash pid *process-conditions*))
 	 (lock
 	  (or (car last)
 	      (sb-thread:make-mutex :name (format nil "lock ~A" pid))))
@@ -2959,7 +2960,7 @@
 ;;;
 ;;; [the following isn't implemented (should it be?)]
 ;;; If object is a list, it is an alist with entries:
-;;; (base-char [modifiers] [mask-modifiers])
+;;; (char8 [modifiers] [mask-modifiers])
 ;;; When MODIFIERS are specified, this character translation
 ;;; will only take effect when the specified modifiers are pressed.
 ;;; MASK-MODIFIERS can be used to specify a set of modifiers to ignore.
diff -urN /home/fare/clx.orig/resource.lisp clx/resource.lisp
--- /home/fare/clx.orig/resource.lisp	2005-07-14 09:24:43.000000000 -0400
+++ clx/resource.lisp	2005-11-08 17:30:03.000000000 -0500
@@ -455,7 +455,7 @@
 
 (defun char-memq (key char)
   ;; Used as a test function for POSITION
-  (declare (type base-char char))
+  (declare (type char8 char))
   (member char key))
 
 (defmacro resource-with-open-file ((stream pathname &rest options) &body body)
diff -urN /home/fare/clx.orig/translate.lisp clx/translate.lisp
--- /home/fare/clx.orig/translate.lisp	2005-07-14 09:24:44.000000000 -0400
+++ clx/translate.lisp	2005-11-08 17:30:26.000000000 -0500
@@ -141,7 +141,7 @@
   ;;      when mask and modifiers aren't lists of keysyms]
   ;; The default is #'default-keysym-translate
   ;;
-  (declare (type (or base-char t) object)
+  (declare (type (or char8 t) object)
 	   (type keysym keysym)
 	   (type (or null mask16 (clx-list (or keysym state-mask-key)))
 	         modifiers)
@@ -191,7 +191,7 @@
 (defun undefine-keysym (object keysym &key display modifiers &allow-other-keys)	              
   ;; Undefine the keysym-translation translating KEYSYM to OBJECT with MODIFIERS.
   ;; If DISPLAY is non-nil, undefine the translation for DISPLAY if it exists.
-  (declare (type (or base-char t) object)
+  (declare (type (or char8 t) object)
 	   (type keysym keysym)
 	   (type (or null mask16 (clx-list (or keysym state-mask-key)))
 	         modifiers)
@@ -447,7 +447,7 @@
 	   (type card8 keycode)
 	   (type card16 state)
 	   (type (or null card8) keysym-index)
-	   (type (or null (function (base-char card16 generalized-boolean card8) card8))
+	   (type (or null (function (char8 card16 generalized-boolean card8) card8))
 		 keysym-index-function))
   (declare (clx-values (or null character)))
   (let* ((index (or keysym-index

Reply via email to