/[cmucl]/src/clx/text.lisp
ViewVC logotype

Diff of /src/clx/text.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6.2.1 by rtoy, Sat May 22 11:54:05 2004 UTC revision 1.9 by rtoy, Wed Jun 17 18:22:46 2009 UTC
# Line 17  Line 17 
17  ;;; Texas Instruments Incorporated provides this software "as is" without  ;;; Texas Instruments Incorporated provides this software "as is" without
18  ;;; express or implied warranty.  ;;; express or implied warranty.
19  ;;;  ;;;
20    
21  #+cmu  #+cmu
22  (ext:file-comment  (ext:file-comment "$Id$")
   "$Header$")  
23    
24  (in-package :xlib)  (in-package :xlib)
25    
# Line 34  Line 34 
34  ;; returned.  ;; returned.
35    
36  (deftype translation-function ()  (deftype translation-function ()
37      #+explorer t
38      #-explorer
39    '(function (sequence array-index array-index (or null font) vector array-index)    '(function (sequence array-index array-index (or null font) vector array-index)
40               (values array-index (or null int16 font) (or null int32))))               (values array-index (or null int16 font) (or null int32))))
41    
# Line 70  Line 72 
72             (type vector dst)             (type vector dst)
73             (inline graphic-char-p))             (inline graphic-char-p))
74    (declare (clx-values integer (or null integer font) (or null integer)))    (declare (clx-values integer (or null integer font) (or null integer)))
75    font ;;not used  
76    (if (stringp src)    (let ((min-char-index (and font (xlib:font-min-char font)))
77        (do ((i src-start (index+ i 1))          (max-char-index (and font (xlib:font-max-char font))))
78             (j dst-start (index+ j 1))      (if (stringp src)
79             (char))          (do ((i src-start (index+ i 1))
80            ((index>= i src-end)               (j dst-start (index+ j 1))
81             i)               (char))
82          (declare (type array-index i j))              ((index>= i src-end)
83          (if (graphic-char-p (setq char (char src i)))               i)
84              (setf (aref dst j) (char->card8 char))            (declare (type array-index i j))
85            (return i)))            (setf char (char->card8 (char src i)))
86        (do ((i src-start (index+ i 1))            (if (and font (or (< char min-char-index) (> char max-char-index)))
87             (j dst-start (index+ j 1))                (return i)
88             (elt))                (setf (aref dst j) char)))
89            ((index>= i src-end)          (do ((i src-start (index+ i 1))
90             i)               (j dst-start (index+ j 1))
91          (declare (type array-index i j))               (elt))
92          (setq elt (elt src i))              ((index>= i src-end)
93          (cond ((and (characterp elt) (graphic-char-p elt))               i)
94                 (setf (aref dst j) (char->card8 elt)))            (declare (type array-index i j))
95                ((integerp elt)            (setq elt (elt src i))
96                 (setf (aref dst j) elt))            (when (characterp elt) (setq elt (char->card8 elt)))
97                (t            (if (or (not (integerp elt))
98                 (return i))))))                    (and font
99                           (< elt min-char-index)
100                           (> elt max-char-index)))
101                  (return i)
102                  (setf (aref dst j) elt))))))
103    
104  ;; There is a question below of whether translate should always be required, or  ;; There is a question below of whether translate should always be required, or
105  ;; if not, what the default should be or where it should come from.  For  ;; if not, what the default should be or where it should come from.  For
# Line 111  Line 117 
117    (declare (type sequence sequence)    (declare (type sequence sequence)
118             (type (or font gcontext) font))             (type (or font gcontext) font))
119    (declare (type (or null translation-function) translate)    (declare (type (or null translation-function) translate)
120             (dynamic-extent translate))             #+clx-ansi-common-lisp
121               (dynamic-extent translate)
122               #+(and lispm (not clx-ansi-common-lisp))
123               (sys:downward-funarg #+Genera * #-Genera translate))
124    (declare (clx-values width ascent descent left right    (declare (clx-values width ascent descent left right
125                    font-ascent font-descent direction                    font-ascent font-descent direction
126                    (or null array-index)))                    (or null array-index)))
# Line 138  Line 147 
147        (do* ((wbuf (display-tbuf16 display))        (do* ((wbuf (display-tbuf16 display))
148              (src-end (or end (length sequence)))              (src-end (or end (length sequence)))
149              (src-start start (index+ src-start buf-end))              (src-start start (index+ src-start buf-end))
150              (end (index-min src-end (index+ src-start *buffer-text16-size*))              (end (index-min src-end (index+ src-start +buffer-text16-size+))
151                   (index-min src-end (index+ src-start *buffer-text16-size*)))                   (index-min src-end (index+ src-start +buffer-text16-size+)))
152              (buf-end 0)              (buf-end 0)
153              (new-font)              (new-font)
154              (font-ascent 0)              (font-ascent 0)
# Line 215  Line 224 
224             (type array-index start)             (type array-index start)
225             (type (or null array-index) end))             (type (or null array-index) end))
226    (declare (type (or null translation-function) translate)    (declare (type (or null translation-function) translate)
227             (dynamic-extent translate))             #+clx-ansi-common-lisp
228               (dynamic-extent translate)
229               #+(and lispm (not clx-ansi-common-lisp))
230               (sys:downward-funarg #+Genera * #-Genera translate))
231    (declare (clx-values integer (or null integer)))    (declare (clx-values integer (or null integer)))
232    (when (type? font 'gcontext)    (when (type? font 'gcontext)
233      (force-gcontext-changes font)      (force-gcontext-changes font)
# Line 231  Line 243 
243        (do* ((wbuf (display-tbuf16 display))        (do* ((wbuf (display-tbuf16 display))
244              (src-end (or end (length sequence)))              (src-end (or end (length sequence)))
245              (src-start start (index+ src-start buf-end))              (src-start start (index+ src-start buf-end))
246              (end (index-min src-end (index+ src-start *buffer-text16-size*))              (end (index-min src-end (index+ src-start +buffer-text16-size+))
247                   (index-min src-end (index+ src-start *buffer-text16-size*)))                   (index-min src-end (index+ src-start +buffer-text16-size+)))
248              (buf-end 0)              (buf-end 0)
249              (new-font)              (new-font)
250              (stop-p nil))              (stop-p nil))
# Line 258  Line 270 
270            (setq font new-font))))            (setq font new-font))))
271      (values width next-start)))      (values width next-start)))
272    
273  (defun text-extents-server (font string start end)  (defun text-extents-server (font sequence start end)
274    (declare (type font font)    (declare (type font font)
275             (type sequence string)             (type sequence sequence)
276             (type array-index start end))             (type array-index start end))
277    (declare (clx-values width ascent descent left right font-ascent font-descent direction))    (declare (clx-values width ascent descent left right font-ascent font-descent direction))
278    (let ((display (font-display font))    (let ((display (font-display font))
# Line 269  Line 281 
281      (declare (type display display)      (declare (type display display)
282               (type array-index length)               (type array-index length)
283               (type resource-id font-id))               (type resource-id font-id))
284      (with-buffer-request-and-reply (display *x-querytextextents* 28 :sizes (8 16 32))      (with-buffer-request-and-reply (display +x-querytextextents+ 28 :sizes (8 16 32))
285           (((data boolean) (oddp length))           (((data boolean) (oddp length))
286            (length (index+ (index-ceiling length 2) 2))            (length (index+ (index-ceiling length 2) 2))
287            (resource-id font-id)            (resource-id font-id)
288            ((sequence :format char2b :start start :end end :appending t)            ((sequence :format char2b :start start :end end :appending t)
289             string))             sequence))
290        (values        (values
291          (integer-get 16)          (integer-get 16)
292          (int16-get 12)          (int16-get 12)
# Line 285  Line 297 
297          (int16-get 10)          (int16-get 10)
298          (member8-get 1 :left-to-right :right-to-left)))))          (member8-get 1 :left-to-right :right-to-left)))))
299    
300  (defun text-width-server (font string start end)  (defun text-width-server (font sequence start end)
301    (declare (type (or font gcontext) font)    (declare (type (or font gcontext) font)
302             (type sequence string)             (type sequence sequence)
303             (type array-index start end))             (type array-index start end))
304    (declare (clx-values integer))    (declare (clx-values integer))
305    (let ((display (font-display font))    (let ((display (font-display font))
# Line 296  Line 308 
308      (declare (type display display)      (declare (type display display)
309               (type array-index length)               (type array-index length)
310               (type resource-id font-id))               (type resource-id font-id))
311      (with-buffer-request-and-reply (display *x-querytextextents* 28 :sizes 32)      (with-buffer-request-and-reply (display +x-querytextextents+ 28 :sizes 32)
312           (((data boolean) (oddp length))           (((data boolean) (oddp length))
313            (length (index+ (index-ceiling length 2) 2))            (length (index+ (index-ceiling length 2) 2))
314            (resource-id font-id)            (resource-id font-id)
315            ((sequence :format char2b :start start :end end :appending t)            ((sequence :format char2b :start start :end end :appending t)
316             string))             sequence))
317        (values (integer-get 16)))))        (values (integer-get 16)))))
318    
319  (defun text-extents-local (font sequence start end width-only-p)  (defun text-extents-local (font sequence start end width-only-p)
# Line 456  Line 468 
468             (type (or null int32) width)             (type (or null int32) width)
469             (type index-size size))             (type index-size size))
470    (declare (type (or null translation-function) translate)    (declare (type (or null translation-function) translate)
471             (dynamic-extent translate))             #+clx-ansi-common-lisp
472               (dynamic-extent translate)
473               #+(and lispm (not clx-ansi-common-lisp))
474               (sys:downward-funarg #+Genera * #-Genera translate))
475    (declare (clx-values generalized-boolean (or null int32)))    (declare (clx-values generalized-boolean (or null int32)))
476    (let* ((display (gcontext-display gcontext))    (let* ((display (gcontext-display gcontext))
477           (result t)           (result t)
478           (opcode *x-polytext8*))           (opcode +x-polytext8+))
479      (declare (type display display))      (declare (type display display))
480      (let ((vector (allocate-gcontext-state)))      (let ((vector (allocate-gcontext-state)))
481        (declare (type gcontext-state vector))        (declare (type gcontext-state vector))
482        (setf (aref vector 0) elt)        (setf (aref vector 0) elt)
483        (multiple-value-bind (new-start new-font translate-width)        (multiple-value-bind (new-start new-font translate-width)
484            (funcall (or translate #'translate-default)            (funcall (or translate #'translate-default)
485                     vector 0 1 (gcontext-font gcontext t) vector 1)                     vector 0 1 (gcontext-font gcontext nil) vector 1)
486          ;; Allow translate to set a new font          ;; Allow translate to set a new font
487          (when (type? new-font 'font)          (when (type? new-font 'font)
488            (setf (gcontext-font gcontext) new-font)            (setf (gcontext-font gcontext) new-font)
# Line 480  Line 495 
495          (when translate-width (setq width translate-width))))          (when translate-width (setq width translate-width))))
496      (when result      (when result
497        (when (eql size 16)        (when (eql size 16)
498          (setq opcode *x-polytext16*)          (setq opcode +x-polytext16+)
499          (setq elt (dpb elt (byte 8 8) (ldb (byte 8 8) elt))))          (setq elt (dpb elt (byte 8 8) (ldb (byte 8 8) elt))))
500        (with-buffer-request (display opcode :gc-force gcontext)        (with-buffer-request (display opcode :gc-force gcontext)
501          (drawable drawable)          (drawable drawable)
# Line 504  Line 519 
519             (type (or null int32) width)             (type (or null int32) width)
520             (type index-size size))             (type index-size size))
521    (declare (type (or null translation-function) translate)    (declare (type (or null translation-function) translate)
522             (dynamic-extent translate))             #+clx-ansi-common-lisp
523               (dynamic-extent translate)
524               #+(and lispm (not clx-ansi-common-lisp))
525               (sys:downward-funarg #+Genera * #-Genera translate))
526    (declare (clx-values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
527    (unless end (setq end (length sequence)))    (unless end (setq end (length sequence)))
528    (ecase size    (ecase size
# Line 525  Line 543 
543             (type (or null int32) width))             (type (or null int32) width))
544    (declare (clx-values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
545    (declare (type translation-function translate)    (declare (type translation-function translate)
546             (dynamic-extent translate))             #+clx-ansi-common-lisp
547               (dynamic-extent translate)
548               #+(and lispm (not clx-ansi-common-lisp))
549               (sys:downward-funarg translate))
550    (let* ((src-start start)    (let* ((src-start start)
551           (src-end (or end (length sequence)))           (src-end (or end (length sequence)))
552           (next-start nil)           (next-start nil)
553           (length (index- src-end src-start))           (length (index- src-end src-start))
554           (request-length (* length 2))          ; Leave lots of room for font shifts.           (request-length (* length 2))          ; Leave lots of room for font shifts.
555           (display (gcontext-display gcontext))           (display (gcontext-display gcontext))
556           ;; Should metrics-p be T?  Don't want to pass a NIL font into translate...           (font (gcontext-font gcontext nil)))
          (font (gcontext-font gcontext t)))  
557      (declare (type array-index src-start src-end length)      (declare (type array-index src-start src-end length)
558               (type (or null array-index) next-start)               (type (or null array-index) next-start)
559               (type display display))               (type display display))
560      (with-buffer-request (display *x-polytext8* :gc-force gcontext :length request-length)      (with-buffer-request (display +x-polytext8+ :gc-force gcontext :length request-length)
561        (drawable drawable)        (drawable drawable)
562        (gcontext gcontext)        (gcontext gcontext)
563        (int16 x y)        (int16 x y)
# Line 625  Line 645 
645             (type (or null int32) width))             (type (or null int32) width))
646    (declare (clx-values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
647    (declare (type translation-function translate)    (declare (type translation-function translate)
648             (dynamic-extent translate))             #+clx-ansi-common-lisp
649               (dynamic-extent translate)
650               #+(and lispm (not clx-ansi-common-lisp))
651               (sys:downward-funarg translate))
652    (let* ((src-start start)    (let* ((src-start start)
653           (src-end (or end (length sequence)))           (src-end (or end (length sequence)))
654           (next-start nil)           (next-start nil)
655           (length (index- src-end src-start))           (length (index- src-end src-start))
656           (request-length (* length 3))          ; Leave lots of room for font shifts.           (request-length (* length 3))          ; Leave lots of room for font shifts.
657           (display (gcontext-display gcontext))           (display (gcontext-display gcontext))
658           ;; Should metrics-p be T?  Don't want to pass a NIL font into translate...           (font (gcontext-font gcontext nil))
          (font (gcontext-font gcontext t))  
659           (buffer (display-tbuf16 display)))           (buffer (display-tbuf16 display)))
660      (declare (type array-index src-start src-end length)      (declare (type array-index src-start src-end length)
661               (type (or null array-index) next-start)               (type (or null array-index) next-start)
662               (type display display)               (type display display)
663               (type buffer-text16 buffer))               (type buffer-text16 buffer))
664      (with-buffer-request (display *x-polytext16* :gc-force gcontext :length request-length)      (with-buffer-request (display +x-polytext16+ :gc-force gcontext :length request-length)
665        (drawable drawable)        (drawable drawable)
666        (gcontext gcontext)        (gcontext gcontext)
667        (int16 x y)        (int16 x y)
# Line 725  Line 747 
747             (type (or null int32) width)             (type (or null int32) width)
748             (type index-size size))             (type index-size size))
749    (declare (type (or null translation-function) translate)    (declare (type (or null translation-function) translate)
750             (dynamic-extent translate))             #+clx-ansi-common-lisp
751               (dynamic-extent translate)
752               #+(and lispm (not clx-ansi-common-lisp))
753               (sys:downward-funarg #+Genera * #-Genera translate))
754    (declare (clx-values generalized-boolean (or null int32)))    (declare (clx-values generalized-boolean (or null int32)))
755    (let* ((display (gcontext-display gcontext))    (let* ((display (gcontext-display gcontext))
756           (result t)           (result t)
757           (opcode *x-imagetext8*))           (opcode +x-imagetext8+))
758      (declare (type display display))      (declare (type display display))
759      (let ((vector (allocate-gcontext-state)))      (let ((vector (allocate-gcontext-state)))
760        (declare (type gcontext-state vector))        (declare (type gcontext-state vector))
761        (setf (aref vector 0) elt)        (setf (aref vector 0) elt)
762        (multiple-value-bind (new-start new-font translate-width)        (multiple-value-bind (new-start new-font translate-width)
763            (funcall (or translate #'translate-default)            (funcall (or translate #'translate-default)
764                     vector 0 1 (gcontext-font gcontext t) vector 1)                     vector 0 1 (gcontext-font gcontext nil) vector 1)
765          ;; Allow translate to set a new font          ;; Allow translate to set a new font
766          (when (type? new-font 'font)          (when (type? new-font 'font)
767            (setf (gcontext-font gcontext) new-font)            (setf (gcontext-font gcontext) new-font)
# Line 749  Line 774 
774          (when translate-width (setq width translate-width))))          (when translate-width (setq width translate-width))))
775      (when result      (when result
776        (when (eql size 16)        (when (eql size 16)
777          (setq opcode *x-imagetext16*)          (setq opcode +x-imagetext16+)
778          (setq elt (dpb elt (byte 8 8) (ldb (byte 8 8) elt))))          (setq elt (dpb elt (byte 8 8) (ldb (byte 8 8) elt))))
779        (with-buffer-request (display opcode :gc-force gcontext)        (with-buffer-request (display opcode :gc-force gcontext)
780          (drawable drawable)          (drawable drawable)
# Line 778  Line 803 
803             (type (or null int32) width)             (type (or null int32) width)
804             (type index-size size))             (type index-size size))
805    (declare (type (or null translation-function) translate)    (declare (type (or null translation-function) translate)
806             (dynamic-extent translate))             #+clx-ansi-common-lisp
807               (dynamic-extent translate)
808               #+(and lispm (not clx-ansi-common-lisp))
809               (sys:downward-funarg #+Genera * #-Genera translate))
810    (declare (clx-values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
811    (setf end (index-min (index+ start 255) (or end (length sequence))))    (setf end (index-min (index+ start 255) (or end (length sequence))))
812    (ecase size    (ecase size
# Line 803  Line 831 
831             (type (or null array-index) end)             (type (or null array-index) end)
832             (type (or null int32) width))             (type (or null int32) width))
833    (declare (type (or null translation-function) translate)    (declare (type (or null translation-function) translate)
834             (dynamic-extent translate))             #+clx-ansi-common-lisp
835               (dynamic-extent translate)
836               #+(and lispm (not clx-ansi-common-lisp))
837               (sys:downward-funarg translate))
838    (declare (clx-values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
839    (do* ((display (gcontext-display gcontext))    (do* ((display (gcontext-display gcontext))
840          (length (index- end start))          (length (index- end start))
841          ;; Should metrics-p be T?  Don't want to pass a NIL font into translate...          (font (gcontext-font gcontext nil))
         (font (gcontext-font gcontext t))  
842          (font-change nil)          (font-change nil)
843          (new-start) (translated-width) (chunk))          (new-start) (translated-width) (chunk))
844         (nil) ;; forever         (nil) ;; forever
# Line 819  Line 849 
849      (when font-change      (when font-change
850        (setf (gcontext-font gcontext) font))        (setf (gcontext-font gcontext) font))
851      (block change-font      (block change-font
852        (with-buffer-request (display *x-imagetext8* :gc-force gcontext :length length)        (with-buffer-request (display +x-imagetext8+ :gc-force gcontext :length length)
853          (drawable drawable)          (drawable drawable)
854          (gcontext gcontext)          (gcontext gcontext)
855          (int16 x y)          (int16 x y)
# Line 866  Line 896 
896             (type (or null array-index) end)             (type (or null array-index) end)
897             (type (or null int32) width))             (type (or null int32) width))
898    (declare (type (or null translation-function) translate)    (declare (type (or null translation-function) translate)
899             (dynamic-extent translate))             #+clx-ansi-common-lisp
900               (dynamic-extent translate)
901               #+(and lispm (not clx-ansi-common-lisp))
902               (sys:downward-funarg translate))
903    (declare (clx-values (or null array-index) (or null int32)))    (declare (clx-values (or null array-index) (or null int32)))
904    (do* ((display (gcontext-display gcontext))    (do* ((display (gcontext-display gcontext))
905          (length (index- end start))          (length (index- end start))
906          ;; Should metrics-p be T?  Don't want to pass a NIL font into translate...          (font (gcontext-font gcontext nil))
         (font (gcontext-font gcontext t))  
907          (font-change nil)          (font-change nil)
908          (new-start) (translated-width) (chunk)          (new-start) (translated-width) (chunk)
909          (buffer (buffer-tbuf16 display)))          (buffer (buffer-tbuf16 display)))
# Line 885  Line 917 
917        (setf (gcontext-font gcontext) font))        (setf (gcontext-font gcontext) font))
918    
919      (block change-font      (block change-font
920        (with-buffer-request (display *x-imagetext16* :gc-force gcontext :length length)        (with-buffer-request (display +x-imagetext16+ :gc-force gcontext :length length)
921          (drawable drawable)          (drawable drawable)
922          (gcontext gcontext)          (gcontext gcontext)
923          (int16 x y)          (int16 x y)
# Line 955  Line 987 
987      (replace data mod3 :start1 (index* 5 keycodes-per-modifier))      (replace data mod3 :start1 (index* 5 keycodes-per-modifier))
988      (replace data mod4 :start1 (index* 6 keycodes-per-modifier))      (replace data mod4 :start1 (index* 6 keycodes-per-modifier))
989      (replace data mod5 :start1 (index* 7 keycodes-per-modifier))      (replace data mod5 :start1 (index* 7 keycodes-per-modifier))
990      (with-buffer-request-and-reply (display *x-setmodifiermapping* 4 :sizes 8)      (with-buffer-request-and-reply (display +x-setmodifiermapping+ 4 :sizes 8)
991           ((data keycodes-per-modifier)           ((data keycodes-per-modifier)
992            ((sequence :format card8) data))            ((sequence :format card8) data))
993        (values (member8-get 1 :success :busy :failed)))))        (values (member8-get 1 :success :busy :failed)))))
# Line 965  Line 997 
997    (declare (type display display))    (declare (type display display))
998    (declare (clx-values shift lock control mod1 mod2 mod3 mod4 mod5))    (declare (clx-values shift lock control mod1 mod2 mod3 mod4 mod5))
999    (let ((lists nil))    (let ((lists nil))
1000      (with-buffer-request-and-reply (display *x-getmodifiermapping* nil :sizes 8)      (with-buffer-request-and-reply (display +x-getmodifiermapping+ nil :sizes 8)
1001           ()           ()
1002        (do* ((keycodes-per-modifier (card8-get 1))        (do* ((keycodes-per-modifier (card8-get 1))
1003              (advance-by *replysize* keycodes-per-modifier)              (advance-by +replysize+ keycodes-per-modifier)
1004              (keys nil nil)              (keys nil nil)
1005              (i 0 (index+ i 1)))              (i 0 (index+ i 1)))
1006             ((index= i 8))             ((index= i 8))
# Line 998  Line 1030 
1030           (size (index* length keysyms-per-keycode))           (size (index* length keysyms-per-keycode))
1031           (request-length (index+ size 2)))           (request-length (index+ size 2)))
1032      (declare (type array-index keycode-end keysyms-per-keycode length request-length))      (declare (type array-index keycode-end keysyms-per-keycode length request-length))
1033      (with-buffer-request (display *x-setkeyboardmapping*      (with-buffer-request (display +x-setkeyboardmapping+
1034                                    :length (index-ash request-length 2)                                    :length (index-ash request-length 2)
1035                                    :sizes (32))                                    :sizes (32))
1036        (data length)        (data length)
# Line 1033  Line 1065 
1065    (unless first-keycode (setq first-keycode (display-min-keycode display)))    (unless first-keycode (setq first-keycode (display-min-keycode display)))
1066    (unless start (setq start first-keycode))    (unless start (setq start first-keycode))
1067    (unless end (setq end (1+ (display-max-keycode display))))    (unless end (setq end (1+ (display-max-keycode display))))
1068    (with-buffer-request-and-reply (display *x-getkeyboardmapping* nil :sizes (8 32))    (with-buffer-request-and-reply (display +x-getkeyboardmapping+ nil :sizes (8 32))
1069         ((card8 first-keycode (index- end start)))         ((card8 first-keycode (index- end start)))
1070      (do* ((keysyms-per-keycode (card8-get 1))      (do* ((keysyms-per-keycode (card8-get 1))
1071            (bytes-per-keycode (* keysyms-per-keycode 4))            (bytes-per-keycode (* keysyms-per-keycode 4))
1072            (advance-by *replysize* bytes-per-keycode)            (advance-by +replysize+ bytes-per-keycode)
1073            (keycode-count (floor (card32-get 4) keysyms-per-keycode)            (keycode-count (floor (card32-get 4) keysyms-per-keycode)
1074                           (index- keycode-count 1))                           (index- keycode-count 1))
1075            (result (if (and (arrayp data)            (result (if (and (arrayp data)

Legend:
Removed from v.1.6.2.1  
changed lines
  Added in v.1.9

  ViewVC Help
Powered by ViewVC 1.1.5