[STUMP] Patch: Non ASCII Chars in Messages

[David Hansen]

First of all:  I don't fully understand what I have done but
this works for me.  I can even

(echo-string (current-screen) "∫dϕ = 2π")

This is tested on sbcl with unicode support enabled.  The key
point is the translate function.  CLX translate function works
only for ASCII chars.  The one i wrote /should/ work with
arbitrary encodings as long as the lisp implementation and the
used font use the same encoding.  But again, only tested with
SBCL.

Well, i think it will only work with the first 2¹⁶ Unicode
characters but that seems to be a xlib limitation.

Can someone with a Latin-1 Lisp please check if the :size 16
key for `xlib:draw-image-glyphs' in `echo-string-list' is
doing anything bad?

David

*** core.lisp   25 Oct 2006 17:29:55 +0200      1.56
--- core.lisp   25 Oct 2006 23:20:11 +0200      
***************
*** 37,42 ****
--- 37,64 ----
          (define-key m (kbd "C-t") '*root-map*)
          m)))
  
+ ;; simple replacement for xlib:translate-default.  just the identity with a
+ ;; range check.
+ 
+ (defun translate-id (src src-start src-end font dst dst-start)
+   (let ((min (xlib:font-min-char font))
+         (max (xlib:font-max-char font)))
+     (decf src-end)
+     (if (stringp src)              ; clx does this test so i guess it's needed
+         (loop for i from src-start to src-end
+               for j from dst-start
+               as c = (char-code (char src i))
+               if (<= min c max) do (setf (aref dst j) c)
+               else do (return i)
+               finally (return i))
+         (loop for i from src-start to src-end
+               for j from dst-start
+               as c = (elt src i)
+               as n = (if (characterp c) (char-code c) c)
+               if (and (integerp n) (<= min n max)) do (setf (aref dst j) n)
+               else do (return i)
+               finally (return i)))))
+ 
  ;; Screen helper functions
  
  (defun screen-x (screen)
***************
*** 565,571 ****
  (defun max-width (font l)
    "Return the width of the longest string in L using FONT."
    (loop for i in l
!       maximize (xlib:text-width font i)))
  
  (defun setup-win-gravity (screen win gravity)
    "Position the x, y of the window according to its gravity."
--- 587,593 ----
  (defun max-width (font l)
    "Return the width of the longest string in L using FONT."
    (loop for i in l
!       maximize (xlib:text-width font i :translate #'translate-id)) )
  
  (defun setup-win-gravity (screen win gravity)
    "Position the x, y of the window according to its gravity."
***************
*** 1055,1061 ****
                                     *message-window-padding*
                                     (+ (* i height)
                                        (xlib:font-ascent (screen-font screen)))
!                                    s)
          when (and highlight
                    (= highlight i))
          do (invert-rect screen message-win
--- 1077,1086 ----
                                     *message-window-padding*
                                     (+ (* i height)
                                        (xlib:font-ascent (screen-font screen)))
!                                    s
!                                      :translate #'translate-id
!                                      ;; needed to display non latin-1 chars
!                                      :size 16)
          when (and highlight
                    (= highlight i))
          do (invert-rect screen message-win