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