[closure-cvs] CVS closure/src/renderer
dlichteblau
dlichteblau at common-lisp.net
Fri Dec 29 21:29:43 UTC 2006
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 at 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 at 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 at 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.
;;
More information about the Closure-cvs
mailing list