Update of /project/closure/cvsroot/closure/src/renderer In directory clnet:/tmp/cvs-serv9505/src/renderer
Modified Files: clim-draw.lisp list-item.lisp raux.lisp renderer.lisp renderer2.lisp Log Message:
Use CXML's rune implementation and XML parser.
--- /project/closure/cvsroot/closure/src/renderer/clim-draw.lisp 2005/07/11 15:57:56 1.4 +++ /project/closure/cvsroot/closure/src/renderer/clim-draw.lisp 2006/12/29 21:29:34 1.5 @@ -4,7 +4,7 @@ ;;; Created: 2003-03-08 ;;; Author: Gilbert Baumann gilbert@base-engineering.com ;;; License: MIT style (see below) -;;; $Id: clim-draw.lisp,v 1.4 2005/07/11 15:57:56 crhodes Exp $ +;;; $Id: clim-draw.lisp,v 1.5 2006/12/29 21:29:34 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann
@@ -197,7 +197,7 @@ (let ((x 0)) (loop for i from start to (1- end) do (let* ((rune (aref runes i))) - (if (white-space-rune-p rune) (setf rune 32)) + (if (white-space-rune-p rune) (setf rune #/U+0020)) (progn (let ((cw (+ (if (white-space-rune-p rune) (+ (rune-width font rune) word-spacing) @@ -236,12 +236,12 @@ (type css-font-desc $font)) (let ((x 0) ($rune 0)) - (declare (type rune $rune)) + (declare (type fixnum $rune)) (declare (type fixnum x)) (loop for i #-GCL of-type #-GCL fixnum from ,start to (the fixnum (1- ,end)) do (locally (declare (fixnum i)) - (setq $rune (aref (the rod ,runes) i)) + (setq $rune (rune-code (aref (the rod ,runes) i))) (if (white-space-rune-p*/no-nl $rune) (setf $rune 32)) (let (($cw 0)) @@ -278,10 +278,10 @@ (let ((buffer-size (length buffer))) (prog1 (iterate-over-runes - (lambda (rune index x cw) + (lambda (code index x cw) index - (let ((fid (css-font-desc-glyph-fid (text-style-font text-style) rune)) - (i (css-font-desc-glyph-index (text-style-font text-style) rune))) + (let* ((fid (css-font-desc-glyph-fid (text-style-font text-style) code)) + (i (css-font-desc-glyph-index (text-style-font text-style) code))) (when (or (not (eq font fid)) (= bptr buffer-size)) ;; we have to spill --- /project/closure/cvsroot/closure/src/renderer/list-item.lisp 2005/06/13 10:14:23 1.3 +++ /project/closure/cvsroot/closure/src/renderer/list-item.lisp 2006/12/29 21:29:38 1.4 @@ -112,19 +112,19 @@ (:circle (coerce (vector (elt +list-style-type-glyphs/circle+ 0)) 'rod)) (:square (coerce (vector (elt +list-style-type-glyphs/square+ 0)) 'rod)) (:decimal - (map 'rod #'char-code + (map 'rod #'char-rune (format nil "~D." n))) (:lower-roman - (map 'rod #'char-code + (map 'rod #'char-rune (format nil "~(~@R~)." n))) (:upper-roman - (map 'rod #'char-code + (map 'rod #'char-rune (format nil "~:@(~@R~)." n))) (:lower-alpha - (map 'rod #'char-code + (map 'rod #'char-rune (format nil "~(~A~)." (integer->abc n)))) (:upper-alpha - (map 'rod #'char-code + (map 'rod #'char-rune (format nil "~:@(~A~)." (integer->abc n)))) (:none (map 'rod #'identity nil)))) --- /project/closure/cvsroot/closure/src/renderer/raux.lisp 2005/03/13 18:03:24 1.5 +++ /project/closure/cvsroot/closure/src/renderer/raux.lisp 2006/12/29 21:29:38 1.6 @@ -30,7 +30,7 @@
(defun pt-data (x) (cond ((text-element-p x) - (map 'string #'code-char (element-text x))) + (map 'string #'rune-char (element-text x))) ((apply 'concatenate 'string (mapcar #'pt-data (element-children x))))))
--- /project/closure/cvsroot/closure/src/renderer/renderer.lisp 2005/03/13 18:03:25 1.10 +++ /project/closure/cvsroot/closure/src/renderer/renderer.lisp 2006/12/29 21:29:39 1.11 @@ -4,7 +4,7 @@ ;;; Created: long ago ;;; Author: Gilbert Baumann gilbert@base-engineering.com ;;; License: MIT style (see below) -;;; $Id: renderer.lisp,v 1.10 2005/03/13 18:03:25 gbaumann Exp $ +;;; $Id: renderer.lisp,v 1.11 2006/12/29 21:29:39 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2002 by Gilbert Baumann
@@ -91,15 +91,15 @@
(defvar +list-style-type-glyphs/disc+ (list ;;u/black-circle u/bullet u/white-bullet u/white-circle - (char-code #\o))) + (char-rune #\o)))
(defvar +list-style-type-glyphs/circle+ (list ;;u/white-circle u/white-bullet u/bullet u/black-circle - (char-code #*))) + (char-rune #*)))
(defvar +list-style-type-glyphs/square+ (list ;;u/black-square u/white-square u/white-bullet u/bullet - (char-code #-))) + (char-rune #-)))
;;;; @@ -117,7 +117,7 @@ ;;; ---- Believed to be correct -----------------------------------------------
(defsubst rune-width (font rune) - (css-font-desc-glyph-width font rune)) + (css-font-desc-glyph-width font (rune-code rune)))
(defun parse-url* (url) (cond ((url:url-p url) url) --- /project/closure/cvsroot/closure/src/renderer/renderer2.lisp 2006/11/06 19:43:01 1.15 +++ /project/closure/cvsroot/closure/src/renderer/renderer2.lisp 2006/12/29 21:29:39 1.16 @@ -4,7 +4,7 @@ ;;; Created: somewhen late 2002 ;;; Author: Gilbert Baumann gilbert@base-engineering.com ;;; License: MIT style (see below) -;;; $Id: renderer2.lisp,v 1.15 2006/11/06 19:43:01 thenriksen Exp $ +;;; $Id: renderer2.lisp,v 1.16 2006/12/29 21:29:39 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann
@@ -2261,8 +2261,8 @@ collect (table-column-maximum-width (table-column table i)))) (min (reduce #'+ mins)) (max (reduce #'+ maxs)) - (gutter (* (1+ (table-number-of-columns table)) (table-horizontal-border-spacing table)))) - ;; + (gutter (* (1+ (table-number-of-columns table)) (table-horizontal-border-spacing table)))) + ;; (setf table.width (cond ;; | 2. If the 'table' or 'inline-table' element has 'width: auto', the @@ -2761,12 +2761,13 @@ before-markers) ;; first off the first thing must be a block-open (unless (eq (caar q) :open) - (error "Barf!")) + (error "Barf! (1)")) (push (my-setup-style (cadar q) (car ss) cbss) ss) ;; (setf mes (car ss)) (unless (cooked-style-block-element-p (car ss)) - (error "Barf!")) + (error "Barf! (2) -- Expected cooked-style-block-element, found ~A" + (cooked-style-display (car ss)))) (setf me (cadar q)) (pop q)
@@ -2960,9 +2961,8 @@ (defun make-black-chunk* (char style) (cons-black-chunk :style style - :data (map '(simple-array (unsigned-byte 16) (*)) - #'identity - (list char)))) + :data (map 'rod ;; war: (simple-array (unsigned-byte 16) (*)) + #'identity (list char))))
;;; first-letter pseudo elements
@@ -3072,7 +3072,7 @@ for i fixnum from 0 do (cond ,@(AND (EQL :PRE WHITE-SPACE) - (list `((= c 10) + (list `((eql c #/U+0010) (let ((ocontext context)) ,(OR LETTER-SPACING-APPLICABLE-P '(unless (= blacki i) @@ -3152,10 +3152,10 @@ (reverse ncontext)) :%here ,(IF LETTER-SPACING-APPLICABLE-P `(if (eql word-spacing :normal) - (list (make-black-chunk* 32 (car ss))) - (list (make-black-chunk* 32 (car ss)) + (list (make-black-chunk* #/U+0020 (car ss))) + (list (make-black-chunk* #/U+0020 (car ss)) (make-kern-chunk word-spacing))) - `(list (make-black-chunk* 32 (car ss)))))) + `(list (make-black-chunk* #/U+0020 (car ss)))))) #-NIL (push (make-instance 'disc-chunk @@ -3169,30 +3169,30 @@ (reverse ncontext)) :%here ,(IF LETTER-SPACING-APPLICABLE-P `(if (eql word-spacing :normal) - (list (make-black-chunk* 32 (car ss))) - (list (make-black-chunk* 32 (car ss)) + (list (make-black-chunk* #/U+0020 (car ss))) + (list (make-black-chunk* #/U+0020 (car ss)) (make-kern-chunk word-spacing))) - `(list (make-black-chunk* 32 (car ss))))) + `(list (make-black-chunk* #/U+0020 (car ss))))) res))) ((:PRE) `(progn ,(IF LETTER-SPACING-APPLICABLE-P `(if (eql word-spacing :normal) - (push (make-black-chunk* 32 (car ss)) res) + (push (make-black-chunk* #/U+0020 (car ss)) res) (progn - (push (make-black-chunk* 32 (car ss)) res) + (push (make-black-chunk* #/U+0020 (car ss)) res) (push (make-kern-chunk word-spacing) res))) - `(push (make-black-chunk* 32 (car ss)) res) ) + `(push (make-black-chunk* #/U+0020 (car ss)) res) ) (setf blacki (+ i 1)))) ((:NOWRAP) `(progn ,(IF LETTER-SPACING-APPLICABLE-P `(if (eql word-spacing :normal) - (push (make-black-chunk* 32 (car ss)) res) + (push (make-black-chunk* #/U+0020 (car ss)) res) (progn - (push (make-black-chunk* 32 (car ss)) res) + (push (make-black-chunk* #/U+0020 (car ss)) res) (push (make-kern-chunk word-spacing) res))) - `(push (make-black-chunk* 32 (car ss)) res) ))))))) + `(push (make-black-chunk* #/U+0020 (car ss)) res) )))))))
(t ,(AND LETTER-SPACING-APPLICABLE-P @@ -4969,6 +4969,9 @@
;; $Log: renderer2.lisp,v $ +;; Revision 1.16 2006/12/29 21:29:39 dlichteblau +;; Use CXML's rune implementation and XML parser. +;; ;; Revision 1.15 2006/11/06 19:43:01 thenriksen ;; Remove compiler-killing evil character from comment. ;;
-
dlichteblau