[cl-typesetting-devel] Update to XML renderer
Klaus Weidner
kw at w-m-p.com
Fri Apr 15 03:17:22 UTC 2005
Hello,
I've upgraded to Marc's latest versions and verified that the XML
renderer still works in clisp :-)
The attached patch is for contrib/examples/xml-renderer/:
- removed the external PDF compressor code in the "html2pdf" script that
isn't needed anymore thanks to salza.
- a one-line change reduces memory consumption by an order of magnitude,
wrapping the entire document in a single macro wasn't a good idea.
- added basic support for some of the most common HTML entities so that
more documents can be rendered. This is a hack, but I'm too lazy to do a
proper Unicode solution at this time...
- fixed the change bars which were being drawn in the wrong place
occasionally, now uses the (with-contextual-style) macro in
kw-extensions.pdf
- various minor cleanups
I'd appreciate feedback if someone tries this, both positive and negative ;-)
-Klaus
-------------- next part --------------
diff -urb ./html2pdf /home/kw/lisp/source/xml-render/html2pdf
--- ./html2pdf 2005-04-14 21:25:35.000000000 -0500
+++ /home/kw/lisp/source/xml-render/html2pdf 2005-04-14 22:05:20.000000000 -0500
@@ -35,6 +35,10 @@
#CLISP=/usr/lib/clisp/full/lisp.run
CLISP=clisp
+# avoid non-standard charsets...
+LC_CTYPE=en_US
+export LC_CTYPE
+
# WARNING: creates fixed-name temp files in current working directory.
# Don't use it if current dir is writable for untrusted users.
@@ -45,13 +49,6 @@
# line if you don't want to use it.
[ -z "$TIDY" ] && TIDY=$(which tidy)
-# Optional: clisp generates uncompressed PDF. Use the "PDF Toolkit"
-# (pdftk) to compress it. See http://www.accesspdf.com/pdftk/
-#
-# Comment out the next line if you don't want to use it.
-# FIXME: pdftk fails on output generated by v66 cl-pdf ?!
-#[ -z "$PDFTK" ] && PDFTK=$(which pdftk)
-
### End of user configurable section
Usage () {
@@ -77,7 +74,3 @@
$CLISP -q -q -M $IMAGE -- "$XML" "$OUT"
[ -x "$TIDY" ] && rm -f "$XML"
-
-[ -x "$PDFTK" ] && {
- "$PDFTK" "$OUT" output "$OUT.new" compress && mv "$OUT.new" "$OUT"
-}
diff -urb ./xml-xform.lisp /home/kw/lisp/source/xml-render/xml-xform.lisp
--- ./xml-xform.lisp 2005-04-14 21:25:50.000000000 -0500
+++ /home/kw/lisp/source/xml-render/xml-xform.lisp 2005-01-30 14:30:34.000000000 -0600
@@ -159,6 +159,18 @@
;;(adjoin '("sect;" #\#) xmls::*entities* :test #'equal))
;;setq xmls::*entities*
;;(adjoin '("nbsp;" #\Space) xmls::*entities* :test #'equal))
+ (setq xmls::*entities*
+ (concatenate 'vector
+ '(("AElig;" #\?)
+ ("sect;" #\#)
+ ("nbsp;" #\Space)
+ ("#8211;" #\-)
+ ("#8217;" #\')
+ ("#8219;" #\`)
+ ("#8220;" #\")
+ ("#8221;" #\")
+ ("#8230;" #\?))
+ xmls::*entities*))
(with-open-file (s file)
(let ((xml (xmls:parse s :compress-whitespace nil)))
(xml-xform #'attr-list-to-assoc xml))))
@@ -255,12 +267,6 @@
;; The XHTML style sheet
-(defvar *font-normal* "Times-Roman")
-(defvar *font-bold* "Times-Bold")
-(defvar *font-italic* "Times-Italic")
-(defvar *font-bold-italic* "Times-BoldItalic")
-(defvar *font-monospace* "Courier")
-
(defun typeset-elem-xform (node parents)
(let ((elem (xml-elem node))
(attr (xml-attr node))
@@ -268,10 +274,10 @@
;; Deal with each element recursively.
(case elem
- ((:html) `(with-style () , at clst))
+ ((:html) (apply #'append (remove-if #'stringp clst)))
- ((:head) `(set-contextual-variable :title
- ,(xml-extract-text (xml-subtree '(:title) node))))
+ ((:head) `((set-contextual-variable :title
+ ,(xml-extract-text (xml-subtree '(:title) node)))))
;; need to preserve :title for :head to work on, due to
;; depth-first search
@@ -282,18 +288,14 @@
((:body)
(if (> *toc-depth* 0)
(let ((toc (remove-if #'null (make-toc))))
- (setf *chapter-nums* nil)
- (setq *chapters* nil)
- `(with-style (:font *font-normal* :font-size 10)
- (set-contextual-variable :header-enabled t)
+ `((set-contextual-variable :header-enabled t)
(set-contextual-variable :footer-enabled t)
(mark-ref-point '(:chapter 0) :data "Table of Contents")
, at toc
:fresh-page
, at clst
(mark-ref-point "DocumentEnd")))
- `(with-style (:font *font-normal* :font-size 10)
- , at clst
+ `(, at clst
(mark-ref-point "DocumentEnd"))))
((:a)
@@ -307,7 +309,8 @@
(append1 out
(if (eql #\# (aref href 0))
`(put-string (format nil " (page ~D)"
- (find-ref-point-page-number ,(subseq href 1))))
+ (find-ref-point-page-number
+ ,(subseq href 1))))
`(with-style ()
" ("
(with-style (:color :blue)
@@ -315,43 +318,12 @@
")"))))
`(with-style () , at out)))
- ((:h1)
- `(with-style ()
- :fresh-page
- (paragraph (:font "Helvetica-Bold" :font-size 20
- :top-margin 14 :bottom-margin 10)
- (apply #'mark-ref-point ',(chp-ref 0 (xml-extract-text node)))
- , at clst)))
-
- ((:h2)
- `(paragraph (:font "Helvetica-BoldOblique"
- :font-size 18 :top-margin 10 :bottom-margin 8)
- (apply #'mark-ref-point ',(chp-ref 1 (xml-extract-text node)))
- , at clst))
-
- ((:h3)
- `(paragraph (:font "Helvetica-Bold" :font-size 16
- :top-margin 10 :bottom-margin 8)
- (apply #'mark-ref-point ',(chp-ref 2 (xml-extract-text node)))
- , at clst))
-
- ((:h4)
- `(paragraph (:font "Helvetica-BoldOblique" :font-size 14
- :top-margin 10 :bottom-margin 8)
- (apply #'mark-ref-point ',(chp-ref 3 (xml-extract-text node)))
- , at clst))
-
- ((:h5)
- `(paragraph (:font "Helvetica-Bold" :font-size 12
- :top-margin 10 :bottom-margin 8)
- (apply #'mark-ref-point ',(chp-ref 4 (xml-extract-text node)))
- , at clst))
-
- ((:h6)
- `(paragraph (:font "Helvetica-BoldOblique" :font-size 12
- :top-margin 10 :bottom-margin 8)
- (apply #'mark-ref-point ',(chp-ref 5 (xml-extract-text node)))
- , at clst))
+ ((:h1) (chapter-markup 0 (xml-extract-text node) clst))
+ ((:h2) (chapter-markup 1 (xml-extract-text node) clst))
+ ((:h3) (chapter-markup 2 (xml-extract-text node) clst))
+ ((:h4) (chapter-markup 3 (xml-extract-text node) clst))
+ ((:h5) (chapter-markup 4 (xml-extract-text node) clst))
+ ((:h6) (chapter-markup 5 (xml-extract-text node) clst))
((:p)
`(paragraph (:font *font-normal* :font-size 10
@@ -508,18 +480,21 @@
;; This is <ins-start />some <b>bold <ins-end />text</b>
((:ins-start)
- `(set-style (:pre-decoration
- #'decoration-green-background)
+ `(with-style ()
+ (set-contextual-style (:pre-decoration
+ #'decoration-green-background))
(change-start-insert)))
((:del-start)
- `(set-style (:post-decoration
- #'decoration-strikethrough)
+ `(with-style ()
+ (set-contextual-style (:post-decoration
+ #'decoration-strikethrough))
(change-start-delete)))
((:ins-end :del-end)
- `(set-style (:pre-decoration :none
- :post-decoration :none)
+ `(with-style ()
+ (set-contextual-style (:pre-decoration :none
+ :post-decoration :none))
(change-end)))
;; Unknown item: insert bright and ugly complaint
@@ -530,12 +505,15 @@
;;; high-level functions
+(defun load-xml-file-xform (input)
+ (xml-xform #'xml-collapse-whitespace
+ (xml-xform #'xml-collapse-sxml-namespace
+ (load-xml-file input))))
+
(defun xhtml-to-typeset (input)
"Read XML input file and transform to typesetting instructions"
;; First some cleanup on the input XML file
- (let ((tree (xml-xform #'xml-collapse-whitespace
- (xml-xform #'xml-collapse-sxml-namespace
- (load-xml-file input)))))
+ (let ((tree (load-xml-file-xform input)))
;; Generate table of contents
#-(and) (setq *chapters* (mapcar (lambda (h)
(xml-extract-text h))
More information about the cl-typesetting-devel
mailing list