[cl-typesetting-devel] various extensions and bug fixes
Klaus Weidner
kw at w-m-p.com
Tue Nov 30 00:51:43 UTC 2004
Hello,
this is a new patch set that replaces the one I had sent on Nov 6th. It
includes all changes from the old one, and a couple of additional or
updated ones. I have split it into separate diffs in the hope of keeping
it more manageable, each diff contains a comment at the head describing
the purpose for that patch. It's again vs. v66 from the repository.
The only dependency is that the new code in "kw-extensions.lisp" needs
access to the pdf:*page* object via the extensions to "references.lisp",
all the others are independent.
Here's the "diffstat" summary for all of them combined. The first two may
be duplicates of other people's fixes.
The main new feature compared to the Nov 6th patches is that the table of
contents now creates a clickable PDF outline menu automatically.
-Klaus
*** Bugfixes
cl-typesetting-kw-2004-11-29-fix-boxmethod.diff
boxes.lisp | 4
cl-typesetting-kw-2004-11-29-fix-pprint.diff
pprint.lisp | 13
cl-typesetting-kw-2004-11-29-fix-predecorate.diff
stroke.lisp | 14
cl-typesetting-kw-2004-11-29-fix-example.diff
test.lisp | 6
*** Extensions
cl-typesetting-kw-2004-11-29-extensions-references.diff
references.lisp | 26 +
cl-typesetting-kw-2004-11-29-extensions-kw.diff
# Depends on the references.lisp patch
cl-typesetting.asd | 2
kw-extensions.lisp | 749 +++++++++++++++++++++++++++++++++--------------------
7 files changed, 523 insertions(+), 291 deletions(-)
-------------- next part --------------
# clisp complains that the defgeneric form for v-split is illegal:
#
# DEFGENERIC V-SPLIT: No initializations are allowed in a generic
# function lambda-list: ((BOX V-MODE-MIXIN) DX DY)
#
# Change :method as a workaround.
#
Index: boxes.lisp
===================================================================
--- boxes.lisp (revision 66)
+++ boxes.lisp (working copy)
@@ -166,11 +166,11 @@
(defmethod adjust-box-dy (box dy baseline)
nil)
-(defgeneric v-split ((box v-mode-mixin) dx dy)
+(defgeneric v-split (box dx dy)
;;; Split a v-mode box vertically into two parts
;; Args: dx - area width, dy - area height
;; Values: box-fitted, box-left, dy-left
- (:method (box dx dy)
+ (:method ((box v-mode-mixin) dx dy)
(declare (ignore dx))
(if (> (dy box) dy)
(values nil box dy)
-------------- next part --------------
# clisp doesn't support using ignore-errors inside iter, use a separate
# function as a workaround. This should probably be reported as a bug for
# clisp or iterate, I haven't tracked it down further.
#
Index: pprint.lisp
===================================================================
--- pprint.lisp (revision 66)
+++ pprint.lisp (working copy)
@@ -38,6 +38,14 @@
char))
line))
+(defun read-from-string-ignoring-errors (string
+ &optional eof-error-p eof-value
+ &key start end preserve-whitespace)
+ (ignore-errors
+ (read-from-string string eof-error-p eof-value
+ :start start :end end
+ :preserve-whitespace preserve-whitespace)))
+
(defun process-lisp-line (line)
(multiple-value-bind (code comment)(split-comment line)
(let* ((cleaned-line (clean-line code))
@@ -49,10 +57,9 @@
(iter:iter
(setf trimmed (position #\Space cleaned-line :start start :test #'char/=))
(while (and trimmed (< trimmed length)))
- (for (values obj end) = (ignore-errors
- (read-from-string
+ (for (values obj end) = (read-from-string-ignoring-errors
cleaned-line nil nil
- :start trimmed :preserve-whitespace t)))
+ :start trimmed :preserve-whitespace t))
(unless (numberp end)
(setf end (position #\Space cleaned-line :start trimmed :test #'char=)))
(while (and (numberp end) (< end length)))
-------------- next part --------------
# Don't draw character pre-decorations on whitespace boxes, the y coordinates
# tend to be wrong. Handle them the same as post-decorations.
#
Index: stroke.lisp
===================================================================
--- stroke.lisp (revision 66)
+++ stroke.lisp (working copy)
@@ -7,14 +7,12 @@
(defmethod stroke (box x y)
)
-(defmethod stroke :before ((box box) x y)
- (if (and (functionp *pre-decoration*)
- (or (typep box 'char-box)
- (typep box 'white-char-box)))
- (funcall *pre-decoration*
- box
- x (+ y (baseline box) (offset box))
- (dx box) (- (dy box)))))
+(defmethod stroke :before ((box char-box) x y)
+ (when (functionp *pre-decoration*)
+ (funcall *pre-decoration*
+ box
+ x (+ y (baseline box) (offset box))
+ (dx box) (- (dy box)))))
(defmethod stroke :after ((box char-box) x y)
(when (functionp *post-decoration*)
-------------- next part --------------
# slightly more descriptive comment for running the complex example.
Index: test.lisp
===================================================================
--- test.lisp (revision 66)
+++ test.lisp (working copy)
@@ -277,7 +277,11 @@
g1))
;;; Example document
-; you need to load the fonts with something like this:
+;
+; Copy the files from the directory "files-for-example/" (included in
+; the cl-typesetting distribution) to the /tmp directory.
+;
+; Then you need to load the fonts with something like this:
; (pdf:load-t1-font "/tmp/cmex10.afm" "/tmp/cmex10.pfb")
; (pdf:load-t1-font "/tmp/cmti10.afm" "/tmp/cmti10.pfb")
-------------- next part --------------
# Bugfix: mark-ref-point didn't allow other keys, so there was no way to
# initialize the "data" slot.
#
# Bugfix: declare X Y arguments as ignorable in stroke method
#
# Extension: if :page-content is initialized to non-NIL, stroking the reference
# will save a reference to the current page for later. This is useful for
# clickable PDF cross-references (i.e. in a table of contents), I didn't see
# a more straightforward way to do this.
#
Index: references.lisp
===================================================================
--- references.lisp (revision 66)
+++ references.lisp (working copy)
@@ -13,22 +13,29 @@
((id :accessor id :initform nil :initarg :id)
(located-pass :accessor located-pass :initform nil)
(data :accessor data :initform nil :initarg :data)
+ (page-content :accessor page-content :initform nil :initarg :page-content)
(page-number :accessor page-number :initform 999)
(x :accessor x :initform nil)
(y :accessor y :initform nil)))
(defmethod located-pass (obj)
+ (declare (ignore obj))
nil)
(defmethod stroke ((ref-point ref-point) x y)
- (when (and (located-pass ref-point) (/= pdf:*page-number* (page-number ref-point)))
+ (when (and (located-pass ref-point)
+ (/= pdf:*page-number* (page-number ref-point)))
(push (id ref-point) *changed-references*))
- (setf (located-pass ref-point) *current-pass*
- (page-number ref-point) pdf:*page-number*
- (x ref-point) x
- (y ref-point) y))
+ (when (page-content ref-point)
+ (setf (page-content ref-point) pdf:*page*))
+ (setf (located-pass ref-point) *current-pass*
+ (page-number ref-point) pdf:*page-number*
+ (x ref-point) x
+ (y ref-point) y))
-(defun mark-ref-point (id &rest args &key (type 'ref-point))
+(defun mark-ref-point (id &rest args
+ &key (type 'ref-point)
+ &allow-other-keys)
(let* ((ref-point (gethash id *reference-table*)))
(when (and ref-point (not (located-pass ref-point)))
(error "Reference ~s is already defined " id))
@@ -50,6 +57,12 @@
(page-number ref-point)
999)))
+(defun find-ref-point-page-content (id)
+ (let ((ref-point (find-ref-point id)))
+ (if (located-pass ref-point)
+ (page-content ref-point)
+ nil)))
+
(defun find-ref-point-page-data (id &optional default)
(let ((ref-point (find-ref-point id)))
(if (located-pass ref-point)
@@ -60,6 +73,7 @@
((action-fn :accessor action-fn :initform nil :initarg :action-fn)))
(defmethod stroke ((action contextual-action) x y)
+ (declare (ignorable x y))
(when (action-fn action)
(funcall (action-fn action))))
-------------- next part --------------
# use the new references and contextual variables code
#
# new automatic table of contents generator
#
# updated itemize code, now supports decimal/roman/alpha
# schemes, and starting from numbers other than one
#
# fancier examples in included test document
#
# Dependency fix: kw-extensions depends on "top-level"
#
Index: cl-typesetting.asd
===================================================================
--- cl-typesetting.asd (revision 66)
+++ cl-typesetting.asd (working copy)
@@ -27,10 +27,10 @@
(:file "hyphenation" :depends-on ("boxes" "hyphenation-fp"))
(:file "layout" :depends-on ("typo" "graphics"))
(:file "tables" :depends-on ("layout"))
- (:file "kw-extensions" :depends-on ("layout"))
(:file "stroke" :depends-on ("layout"))
(:file "references" :depends-on ("specials"))
(:file "top-level" :depends-on ("stroke" "typo" "references"))
+ (:file "kw-extensions" :depends-on ("top-level" "hyphenation"))
; (:file "test" :depends-on ("top-level" "tables" "math"))
(:file "pprint" :depends-on ("top-level"))
)
Index: kw-extensions.lisp
===================================================================
--- kw-extensions.lisp (revision 66)
+++ kw-extensions.lisp (working copy)
@@ -1,109 +1,150 @@
-;;; Klaus Weinder extensions
+;;; Klaus Weidner extensions
;;; This stuff will be dispatched into better locations later.
(in-package typeset)
-;; these references are superseded by the ones in references.lisp
-;; reference handling
+;; user-configurable default settings
-(defvar *ref-table* (make-hash-table :test #'equal))
-(defvar *ref-counter* 0)
-(defvar *bad-reference* nil)
+(defvar *paper-size* :letter
+ "Paper format, supported values as in tt:top-level, i.e. :a4 or :letter")
-(defclass ref-mark ()
- ((id :accessor ref-id :initform nil :initarg :id)
- (value :accessor ref-mark-value :initform nil :initarg :value)
- (page :accessor ref-mark-page :initform nil)
- (x :accessor ref-x :initform nil)
- (y :accessor ref-y :initform nil)))
+(defvar *page-margins* '(72 72 72 50)
+ "Print margins LEFT TOP RIGHT BOTTOM in 1/72 inch units")
-(defmethod stroke ((mark ref-mark) x y)
- (setf (ref-mark-page mark) pdf:*page-number*
- (ref-x mark) x
- (ref-y mark) y))
+(defvar *twosided* t
+ "If true, use alternating page headers suitable for duplex printing.")
-(defmacro ref-get (id)
- `(gethash ,id *ref-table*))
+(defvar *toc-depth* 3
+ "Number of heading levels to print in table of contents.")
-(defun make-ref-mark (id &optional value)
- (let ((mark (or (ref-get id)
- (make-instance 'ref-mark
- :id id))))
- (setf (ref-get id) mark)
- (setf (ref-mark-value mark) value)
- (add-box mark)))
+(defvar *watermark-fn* nil
+ ;; FIXME: currently draws on top of page instead of below new
+ ;; content. Needs toplevel extension :new-page-fn
+ "Run this function (with the current PAGE as argument )for each new
+page before printing anything on it. Useful for watermarks or
+corporate identity decorations.")
-(defun ref-page (id)
- (let* ((ref (ref-get id))
- (page (if ref (ref-mark-page ref))))
- (cond (page page)
- (t (push id *bad-reference*)
- 999))))
+(defvar *add-chapter-numbers* t)
-(defun put-ref-page (id)
- (put-string (format nil "~D" (ref-page id))))
+(defvar *verbose* nil
+ "Print progress report while running.")
-(defgeneric ref-value (ref))
+(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")
-(defmethod ref-value ((ref ref-mark))
- (if ref (ref-mark-value ref)))
+(defvar *default-text-style*
+ (list :font *font-normal* :font-size 10
+ :top-margin 3 :bottom-margin 4))
-(defmethod ref-value ((id t))
- (let ((ref (ref-get id)))
- (if ref (ref-mark-value ref))))
+(defvar *chapter-styles*
+ '((:font "Helvetica-Bold" :font-size 20
+ :top-margin 14 :bottom-margin 10)
+ (:font "Helvetica-BoldOblique"
+ :font-size 18 :top-margin 10 :bottom-margin 8)
+ (:font "Helvetica-Bold" :font-size 16
+ :top-margin 10 :bottom-margin 8)
+ (:font "Helvetica-BoldOblique" :font-size 14
+ :top-margin 10 :bottom-margin 8)
+ (:font "Helvetica-Bold" :font-size 12
+ :top-margin 10 :bottom-margin 8)
+ (:font "Helvetica-BoldOblique" :font-size 12
+ :top-margin 10 :bottom-margin 8))
+ "Paragraph styles used for various depths of section headings")
-(defun put-ref-value (id)
- (put-string (ref-value id)))
+;; state for internal chapter handling
-(defun this-page-number ()
- pdf:*page-number*)
+(defvar *chapters* nil
+ "Ordered list of chapter information. For each chapter, contains
+reference and title. Example:
-(defun make-ref-page-mark (reftype value)
- (make-ref-mark (cons reftype (incf *ref-counter*)) value))
+ (((:chapter (1)) \"Intro\")
+ ((:chapter (1 1)) \"More stuff\"))")
-(defun get-latest-ref-to (reftype for-page)
- (let ((refs nil))
- ;; Find all references of a type, store unsorted
- ;; (ordinal page ref) lists in "refs".
- (maphash (lambda (key ref)
- (if (and (consp key)
- (equal reftype (car key)))
- (push (list (cdr key)
- (or (ref-mark-page ref) most-positive-fixnum)
- ref)
- refs)))
- *ref-table*)
- ;; Now walk through the reverse sorted references,
- ;; and get the last matching one on or before the
- ;; current page.
- (third (find-if (lambda (page)
- (<= page for-page))
- (sort refs #'> :key #'car)
- :key #'cadr))))
+(defvar *chapter-nums* nil
+ "List of chapter numbers of current section, i.e. (1 2 3) for 1.2.3")
-(defun current-ref-value (reftype)
- (ref-value (get-latest-ref-to reftype (this-page-number))))
+(defvar *change-bar-start* nil)
+(defvar *change-bar-end* nil)
-(defmacro itemize ((&key (indent 20)
- text-style
- (item-fmt "~D. ")
- (start-from 1)
- item-style)
- &body body)
- `(let ((%enumerate-indents% (cons ,indent %enumerate-indents%)))
- ,@(loop for item in body
- for i from start-from collect
- `(paragraph (:left-margin (reduce #'+ %enumerate-indents%)
- :first-line-indent (- ,indent)
- , at text-style)
- (with-style ,item-style
- (put-filled-string ,(format nil item-fmt i)
- ,indent :align :right))
- ,item))))
+;;; higher-level chapter number and table of contents handling
-(defmacro item ((&rest style) &body body)
- `(with-style ,style , at body))
+(defun chpnum-string (nums)
+ (format nil "~{~S~^.~}" nums))
+(defun new-chp-ref (level text)
+ "Insert current chapter information into *chapters*, automatically
+incrementing the elements of *chapter-nums*. Returns an ID suitable for a reference."
+ (let ((higher (subseq *chapter-nums* 0 level))
+ (current (nth level *chapter-nums*)))
+ (setq *chapter-nums* (if current
+ (append higher (list (1+ current)))
+ (append higher (list 1)))))
+ (let ((cs (cons :chapter *chapter-nums*)))
+ (push (list cs text) *chapters*)
+ cs))
+
+(defun chp-ref (level text)
+ ;; OBSOLETE, fixme, use new-chp-ref instead
+ (list (new-chp-ref level text) :data text))
+
+(defun make-toc ()
+ "Generate table of contents from the information in *chapters*, to
+maximum depth *toc-depth*."
+ ;; FIXME: Indentation and font selection currently hardcoded
+ (prog1
+ (mapcar (lambda (chp)
+ ;; format table of contents entry
+ (let* ((ref (first chp))
+ (cnum (cdr ref))
+ (depth (length cnum))
+ (title (second chp)))
+ (when (<= depth *toc-depth*)
+ `(paragraph (:h-align :left-but-last
+ :left-margin
+ ,(case depth
+ (1 0) (2 10) (t 20))
+ :top-margin
+ ,(case depth
+ (1 3) (t 0))
+ :bottom-margin
+ ,(case depth
+ (1 2) (t 0))
+ :font-size
+ ,(case depth
+ (1 12) (2 10) (t 9)))
+ (put-string ,(chpnum-string cnum))
+ (put-string " ")
+ (put-string ,title)
+ (dotted-hfill)
+ (with-style (:font-size 10) (put-ref-point-page-number ',ref))))))
+ (reverse *chapters*))
+ (setf *chapter-nums* nil
+ *chapters* nil)))
+
+(defun chapter-markup (level heading &optional content)
+ (let* ((ref-id (new-chp-ref level heading))
+ (cprefix (if *add-chapter-numbers*
+ (concatenate 'string (chpnum-string (cdr ref-id)) ". ")
+ ""))
+ (numbered-heading (concatenate 'string cprefix heading)))
+ `(pdf:with-outline-level (,numbered-heading
+ (pdf::register-named-reference
+ (vector (find-ref-point-page-content ',ref-id) "/Fit")
+ ,(pdf::gen-name "R")))
+ ,(if (eql level 0) :fresh-page "")
+ ,(if (eql level 0) `(set-contextual-variable :chapter ,heading) "")
+ (paragraph ,(nth level *chapter-styles*)
+ (mark-ref-point ',ref-id :data ,heading :page-content t)
+ (put-string ,cprefix)
+ ,@(if (null content)
+ (list heading)
+ content)))))
+
+;; higher-level layout
+
(defun put-filled-string (string width &key (align :left))
"place aligned string in fixed-width space"
(let* ((string-width
@@ -117,22 +158,85 @@
((:right) (hspace blank) (verbatim string)))))
-;; higher-level layout
+(defun put-ref-point-page-number (ref)
+ (put-string (format nil "~d" (find-ref-point-page-number ref))))
-(defun safe-read (stream)
- (let ((*package* (find-package "TYPESET"))
- (*read-eval* nil))
- (read stream)))
+(defun put-ref-point-value (ref)
+ (put-string (find-ref-point-page-data ref "*undefined*")))
+(defun number-base-list (n base)
+ "Return number N converted to base BASE, represented as list of
+integers, lowest first. Example: (number-base-list 18 16) => (2 1)"
+ (multiple-value-bind (remainder digit) (truncate n base)
+ (if (> remainder 0)
+ (cons digit (number-base-list remainder base))
+ (list digit))))
+
+(defun alpha-item (stream num &optional colon-p at-sign-p)
+ "Prints input NUM to STREAM as sequence of letters corresponding to
+a base-26 representation. Intended for use as custom FORMAT handler,
+Use with colon modifier for uppercase."
+ (declare (ignore at-sign-p))
+ (princ (map 'string
+ (lambda (digit)
+ (code-char (+ (char-code (if colon-p #\a #\A))
+ digit
+ -1)))
+ (nreverse (number-base-list num 26)))
+ stream))
+
+ (defmacro item ((&rest style) &body body)
+ "Render a list item. If BODY is a PARAGRAPH, use its body only."
+ (if (and (consp (car body))
+ (eq 'paragraph (caar body)))
+ `(with-style ,style ,@(nthcdr 2 (car body)) ,@(cdr body))
+ `(with-style ,style , at body)))
+
+(defmacro itemize ((&key (indent 20)
+ (item-fmt "~D. ")
+ (start-from 1)
+ text-style
+ item-style)
+ &body body)
+ "Render the BODY (which must contain of child ITEM elements) as an
+itemized list. Usable both for ordered lists (formatted using
+ITEM-FMT) and unordered list (using a constant string as ITEM-FMT).
+
+Arguments:
+
+item-fmt Format string used to print the integer item number.
+ Use a constant string for unordered (bullet) lists.
+ Useful values include:
+ \"~D. \" Decimal: 1. 2. 3. 4.
+ \"~@R \" Roman: I II III IV
+ \"~(~@R~) \" lc roman: i ii iii iv
+ \"~/tt::alpha-item/. \" Alpha: A. B. C. ... AA. AB.
+ \"~:/tt::alpha-item/. \" lc alpha: a. b. c. ... aa. ab.
+
+start-from Number of the first item, default 1
+
+item-style Style used for printing the item numbers.
+
+text-style Style used for printing the item body text."
+ `(let ((%enumerate-indents% (cons ,indent %enumerate-indents%)))
+ ,@(loop for item in body
+ for i from start-from collect
+ `(paragraph (:left-margin (reduce #'+ %enumerate-indents%)
+ :first-line-indent (- ,indent)
+ , at text-style)
+ (with-style ,item-style
+ (put-filled-string ,(format nil item-fmt i)
+ ,indent :align :right))
+ ,item))))
+
;; change bars
-(defvar *change-bar-start* nil)
-(defvar *change-bar-end* nil)
-
(defclass change-mark ()
((type :accessor mark-type :initform nil :initarg :type)))
(defmethod stroke ((mark change-mark) x y)
+ ;; "stroking" change marks just records their positions for later
+ ;; rendering in the postprocessing hook
(cond ((eq :start-insert (mark-type mark))
(push (cons (+ y *font-size*)
:insert) *change-bar-start*))
@@ -150,12 +254,27 @@
(defun change-end ()
(add-box (make-instance 'change-mark :type :end)))
-(defun page-decorations (page)
+(defun draw-change-bars (page)
+ ;; called when page is being finalized, draw the change bars based
+ ;; on the recorded positions.
(pdf:with-saved-state
- (pdf:set-line-width 2.0)
- (let ((xm (if (oddp (this-page-number))
- (* 0.95 (aref (pdf::bounds page) 2))
- (* 0.05 (aref (pdf::bounds page) 2)))))
+ (pdf:set-line-width 2.0)
+ (let ((xm (if (oddp pdf:*page-number*)
+ ;; this assumes 72pt margins
+ (- (aref (pdf::bounds page) 2) 48)
+ (+ 48 4)))
+ (cross-page nil))
+
+ (when (> (length *change-bar-start*)
+ (length *change-bar-end*))
+ ;; close cross-page change bar(s)
+ ;; FIXME: need to handle two cross-page bars
+ (setq cross-page
+ (list (cons (- (aref (pdf::bounds page) 3)
+ (nth 1 *page-margins*))
+ (cdar *change-bar-start*))))
+ (push (nth 3 *page-margins*) *change-bar-end*))
+
(loop for y0c in *change-bar-start*
for y1 in *change-bar-end*
do
@@ -170,75 +289,158 @@
(pdf:set-color-stroke color)
(pdf:move-to x y0)
(pdf:line-to x y1)
- (pdf:stroke)))))
- (setq *change-bar-start* nil
- *change-bar-end* nil))
+ (pdf:stroke)))
+
+ (setq *change-bar-start* cross-page
+ *change-bar-end* nil))))
+(defun draw-watermark (page)
+ "Put the watermark on the page. FIXME: currently draws on top of
+page instead of below new ;; content. Needs toplevel extension
+:new-page-fn"
+ (declare (ignorable page))
+ (when (functionp *watermark-fn*)
+ (pdf:with-saved-state
+ (funcall *watermark-fn* page))))
+
+(defun page-decorations (page)
+ (draw-watermark page)
+ (draw-change-bars page))
+
+;; This is needed to allow style settings to survive across separate
+;; draw-pages/compile-text invocations.
+(defmacro set-contextual-style (style)
+ `(progn
+ (set-contextual-variable :style ',style)
+ (set-style ,style)))
+
;; Note that the tree argument to render-document is a dead list of
;; symbols and strings. This is a prerequisite for being to handle
;; documents that are completely generated at runtime.
-(defun render-document (tree &key
- (file #P"/tmp/stuff.pdf")
- (twosided t)
- (paper-size :letter))
- "Render the document specified by tree, which is a s-exp containing
-recursive typesetting commands. It gets eval'ed here to typeset it."
- (do ((*ref-table* (make-hash-table :test #'equal))
- (*ref-counter* 0)
- (*bad-reference* nil)
- (pass 0 (1+ pass)))
- ((or (> pass 1)
- (and (> pass 0)
- (not *bad-reference*)))
- *bad-reference*)
- (setq *bad-reference* nil)
- (format t "Pass ~d~%" pass)
- (with-document ()
- (let ((margins '(72 72 72 50))
- (header (lambda (pdf:*page*)
- (if (current-ref-value :header-enabled)
- (let ((inside (or (current-ref-value :title) "Untitled Document"))
- (outside (current-ref-value :chapter)))
- (if (and twosided (evenp (this-page-number)))
- (compile-text (:font "Times-Roman" :font-size 10)
- (hbox (:align :center :adjustable-p t)
- (put-string outside)
- :hfill
- (with-style (:font "Times-Italic")
- (put-string inside))))
- (compile-text (:font "Times-Roman" :font-size 10)
- (hbox (:align :center :adjustable-p t)
- (with-style (:font "Times-Italic")
- (put-string inside))
- :hfill
- (put-string outside))))))))
- (footer (lambda (pdf:*page*)
- (if (current-ref-value :footer-enabled)
- (let ((inside (or (current-ref-value :version) ""))
- (outside (format nil "Page ~d of ~d"
- (this-page-number)
- (ref-page "DocumentEnd"))))
- (if (and twosided (evenp (this-page-number)))
- (compile-text (:font "Times-Roman" :font-size 10)
- (hbox (:align :center :adjustable-p t)
- (put-string outside)
- :hfill
- (put-string inside)))
- (compile-text (:font "Times-Roman" :font-size 10)
- (hbox (:align :center :adjustable-p t)
- (put-string inside)
- :hfill
- (put-string outside)))))))))
-
- (draw-pages (eval (list 'compile-text () tree))
- :margins margins :header header :footer footer
- :size paper-size :finalize-fn #'page-decorations)
- (when pdf:*page* (finalize-page pdf:*page*))
- (pdf:write-document file)))))
+(defun render-document (trees &key
+ (file #P"/tmp/output.pdf")
+ (twosided *twosided*)
+ (paper-size *paper-size*))
+ "Render the document specified by the trees, which is a s-exp containing
+a list of recursive typesetting commands. It gets eval'ed here to typeset it."
+ (setq nix::*left-hyphen-minimum* 999
+ nix::*right-hyphen-minimum* 999)
+ (tt:with-document ()
+ (let ((margins *page-margins*)
+ (header (lambda (pdf:*page*)
+ (if (get-contextual-variable :header-enabled)
+ (let ((inside (get-contextual-variable :title "*Untitled Document*"))
+ (outside (get-contextual-variable :chapter "*No Chapter*")))
+ (if (and twosided (evenp pdf:*page-number*))
+ (compile-text ()
+ (with-style (:font-size 10
+ :pre-decoration :none
+ :post-decoration :none)
+ (hbox (:align :center :adjustable-p t)
+ (with-style (:font *font-normal*)
+ (put-string outside))
+ :hfill
+ (with-style (:font *font-italic*)
+ (put-string inside)))))
+
+ (compile-text ()
+ (with-style (:font-size 10
+ :pre-decoration :none
+ :post-decoration :none)
+ (hbox (:align :center :adjustable-p t)
+ (with-style (:font *font-italic*)
+ (put-string inside))
+ :hfill
+ (with-style (:font *font-normal*)
+ (put-string outside)))))))
+ (compile-text () ""))))
+
+ (footer (lambda (pdf:*page*)
+ (if (get-contextual-variable :footer-enabled)
+ (let ((inside (get-contextual-variable :version ""))
+ (outside (format nil "Page ~d of ~d"
+ pdf:*page-number*
+ (find-ref-point-page-number "DocumentEnd"))))
+ (if (and twosided (evenp pdf:*page-number*))
+ (compile-text ()
+ (with-style (:font *font-normal*
+ :font-size 10
+ :pre-decoration :none
+ :post-decoration :none)
+ (hbox (:align :center :adjustable-p t)
+ (put-string outside)
+ :hfill
+ (put-string inside))))
+ (compile-text ()
+ (with-style (:font *font-normal*
+ :font-size 10
+ :pre-decoration :none
+ :post-decoration :none)
+ (hbox (:align :center :adjustable-p t)
+ (put-string inside)
+ :hfill
+ (put-string outside))))))
+ (compile-text () "")))))
+
+ (set-contextual-variable :header-enabled nil)
+ (set-contextual-variable :footer-enabled nil)
+ (set-contextual-style (:pre-decoration :none))
+
+ (dolist (tree trees)
+ (draw-pages (eval `(compile-text ()
+ (with-style ,*default-text-style*
+ (set-style ,(get-contextual-variable :style ()))
+ ,tree)))
+ :margins margins
+ :header header
+ :footer footer
+ :size paper-size
+ :finalize-fn #'page-decorations))
-;; Example follows.
+ (when pdf:*page* (finalize-page pdf:*page*))
+ (when (and (final-pass-p)
+ *undefined-references*)
+ (format t "Undefined references:~%~S~%"
+ *undefined-references*))
+
+ (pdf:write-document file))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; end of code, examples follow ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun document-test-simple ()
+ (render-document
+ `((paragraph () "Table of Contents")
+ ,@(make-toc)
+ :fresh-page
+
+ ,(chapter-markup 0 "Introduction")
+ (paragraph () "test")
+ ,(chapter-markup 1 "More stuff")
+ (paragraph () "and more text")
+ ,(chapter-markup 0 "New chapter")
+ (paragraph () "and even more text")
+ (mark-ref-point "DocumentEnd"))))
+
+;;;
+
+(defun watermark-draft (page)
+ "Example for a page decoration"
+ (declare (ignorable page))
+ (pdf:with-saved-state
+ (pdf:in-text-mode
+ (pdf:set-text-rendering-mode 1)
+ (pdf:set-color-stroke #xcccccc)
+ (pdf:set-line-width 4)
+ (pdf:set-font (pdf:get-font "Helvetica-Bold") 200.0)
+ (pdf:translate 180 100)
+ (pdf:rotate 55)
+ (pdf:move-text 0 0)
+ (pdf:draw-text "D r a f t"))))
+
(defun decoration-random-background (box x y dx dy)
(pdf:with-saved-state
(pdf:set-rgb-fill (random 1.0) (random 1.0) (random 1.0))
@@ -248,9 +450,16 @@
(defun decoration-green-background (box x y dx dy)
(pdf:with-saved-state
(pdf:set-rgb-fill 0.7 1.0 0.7)
- (pdf:basic-rect x y dx dy)
+ (pdf:basic-rect x (- y 2) dx (- 1 *font-size*))
(pdf:fill-path)))
+(defun decoration-circles (box x y dx dy)
+ (pdf:with-saved-state
+ (pdf:set-color-stroke #xff33cc)
+ (pdf:set-line-width 0.3)
+ (pdf:circle (+ x (* 0.5 dx)) (+ y (* 0.60 dy)) (* *font-size* 0.4))
+ (pdf:stroke)))
+
(defun decoration-gray-box (box x y dx dy)
(pdf:with-saved-state
(pdf:set-gray-stroke 0.5)
@@ -261,7 +470,7 @@
(defun decoration-underline (box x y dx dy)
(pdf:with-saved-state
(pdf:set-gray-stroke 0)
- (pdf:set-line-width 0.5)
+ (pdf:set-line-width (* 0.06 *font-size*))
(pdf:move-to x (+ y (* 0.9 dy)))
(pdf:line-to (+ x dx) (+ y (* 0.9 dy)))
(pdf:stroke)))
@@ -269,7 +478,7 @@
(defun decoration-strikethrough (box x y dx dy)
(pdf:with-saved-state
(pdf:set-color-stroke :red)
- (pdf:set-line-width 0.5)
+ (pdf:set-line-width (* 0.06 *font-size*))
(pdf:move-to x (+ y (* 0.66 dy)))
(pdf:line-to (+ x dx) (+ y (* 0.66 dy)))
(pdf:stroke)))
@@ -288,138 +497,138 @@
(defun document-test ()
(render-document
- '(with-style (:font "Times-Roman" :font-size 12
- :top-margin 3 :bottom-margin 4)
- (make-ref-page-mark :title "Titled Document")
- (make-ref-page-mark :version "Version 1.x")
- (make-ref-page-mark :header-enabled nil)
- (make-ref-page-mark :footer-enabled nil)
+ '((set-contextual-variable :title "Titled Document")
+ (set-contextual-variable :version "Version 1.x")
+
+ (set-contextual-variable :header-enabled t)
+ (set-contextual-variable :footer-enabled t)
- #||
- :vfill
- (paragraph (:font "Helvetica-Bold" :font-size 24 :h-align :center :bottom-margin 20)
- "This is the Document Title")
- (paragraph (:font "Helvetica-Bold" :font-size 16 :h-align :center)
- "A. N. Author")
- :vfill
- :eop
- ||#
-
- (make-ref-page-mark :header-enabled t)
- (make-ref-page-mark :footer-enabled t)
- (make-ref-mark '(:chapter . 0) "Table of Contents")
- (with-style (:font "Helvetica")
+ (mark-ref-point '(:chapter . '(0)) :data "Table of Contents")
+ (with-style (:font *font-normal*)
(paragraph (:h-align :left-but-last :top-margin 3 :bottom-margin 4)
- (put-ref-value '(:chapter . 1))
- (dotted-hfill)
- (put-ref-page '(:chapter . 1)))
+ (put-ref-point-value '(:chapter . '(1)))
+ (dotted-hfill)
+ (put-ref-point-page-number '(:chapter . '(1))))
(paragraph (:h-align :left-but-last :top-margin 3 :bottom-margin 4)
- (put-ref-value '(:chapter . 2))
- "This is a chapter with an insanely long title, to verify if the leader dots at the end of the line will be printed properly"
- (dotted-hfill)
- (put-ref-page '(:chapter . 2))))
- #||
- :eop
- ||#
+ (put-ref-point-value '(:chapter . '(2)))
+ " This is a chapter with an insanely long title, to verify if the leader dots at the end of the line will be printed properly"
+ (dotted-hfill)
+ (put-ref-point-page-number '(:chapter . '(2)))))
- (make-ref-mark '(:chapter . 1) "Introduction")
+ (mark-ref-point '(:chapter . '(1)) :data "Introduction")
(paragraph (:h-align :left :top-margin 3 :bottom-margin 4)
- "Test with "
- (with-style (:font "Times-Bold")
- "bold")
- " and "
- (with-style (:font "Times-Italic")
- "italic")
- " text.")
+ "Test with "
+ (with-style (:font *font-bold*)
+ "bold")
+ " and "
+ (with-style (:font *font-italic*)
+ "italic")
+ " text.")
- #||
+ (paragraph (:top-margin 3 :bottom-margin 4)
+ "This paragraph has an undefined reference (see page "
+ (put-ref-point-page-number "no-such-ref")
+ "), and mentions KITTENS."
+ (mark-ref-point "KITTENS"))
+
(paragraph (:h-align :left :top-margin 3 :bottom-margin 4)
- (make-ref-mark "link-from")
- "See also stuff on page "
- (put-ref-page "stuff")
- ".")
- ||#
+ "This paragraph has some "
+ (change-start-insert)
+ (with-style (:pre-decoration #'decoration-green-background)
+ "inserted words")
+ (change-end)
+ " in it. Here's some filler to move to the next line. The now following line has both "
+ (change-start-insert)
+ (with-style (:pre-decoration #'decoration-green-background)
+ "inserted words")
+ (change-end)
+ " and "
+ (change-start-delete)
+ (with-style (:post-decoration #'decoration-strikethrough)
+ "deleted ones")
+ "."
+ (change-end)
+ " Now here's even more filler text to again move to the next
+line, to demonstrate having just the following word "
+ (change-start-delete)
+ (with-style (:post-decoration #'decoration-strikethrough)
+ "deleted")
+ (change-end)
+ ".")
(paragraph (:top-margin 3 :bottom-margin 4)
- "Inline alignment test: ["
- (put-filled-string "L" 30)
- "]["
- (put-filled-string "C" 30 :align :center)
- "]["
- (put-filled-string "R" 30 :align :right)
- "]")
+ "These are some "
+ (change-start-insert)
+ (set-contextual-style (:pre-decoration #'decoration-green-background))
+ "random words. The changed area starts in this paragraph.")
+
+ (paragraph (:top-margin 3 :bottom-margin 4)
+ "The end-of-change marker is in this paragraph, in the middle of "
+ (with-style (:font *font-italic*)
+ "italic"
+ (change-end)
+ (set-contextual-style (:pre-decoration :none))
+ " text.")
+ "The change markers are handled in depth-first tree order and
+are not required to be nested with the content. That makes automated change marking much easier.")
+
(paragraph (:top-margin 3 :bottom-margin 4)
- "This is just normal text. "
- (with-style (:pre-decoration #'decoration-random-background)
- "This should look different.")
- " Back to normal. There's more; "
- (with-style (:post-decoration #'decoration-underline)
- "multi word underline")
- " and "
- (with-style (:pre-decoration #'decoration-gray-box)
- "visible boxes mode")
- " and "
- (with-style (:post-decoration #'decoration-crosshatch)
- "crosshatch."))
+ "Just for fun, here are some more text decoration
+experiments. This is just normal text. "
+ (with-style (:pre-decoration #'decoration-random-background)
+ "This should look different.")
+ " Back to normal. There's more; "
+ (with-style (:post-decoration #'decoration-underline)
+ "multi word underline,")
+ " and "
+ (with-style (:pre-decoration #'decoration-gray-box)
+ "visible boxes mode,")
+ " and "
+ (with-style (:pre-decoration #'decoration-circles)
+ "circles,")
+ " and "
+ (with-style (:post-decoration #'decoration-crosshatch)
+ "crosshatch."))
(paragraph (:top-margin 3 :bottom-margin 4)
- "This paragraph is not interesting.")
+ "Inline alignment test: ["
+ (put-filled-string "L" 30)
+ "]["
+ (put-filled-string "C" 30 :align :center)
+ "]["
+ (put-filled-string "R" 30 :align :right)
+ "]")
-
- (paragraph (:h-align :left :top-margin 3 :bottom-margin 4)
- "This paragraph has some "
- (change-start-insert)
- (with-style (:pre-decoration #'decoration-green-background)
- "inserted words")
- (change-end)
- " in it. Here's some filler to move to the next line. The now following line has both "
- (change-start-insert)
- (with-style (:pre-decoration #'decoration-green-background)
- "inserted words")
- (change-end)
- " and "
- (change-start-delete)
- (with-style (:post-decoration #'decoration-strikethrough)
- "deleted ones")
- "."
- (change-end)
- " Now here's even more filler text to again move to the next
-line, to demonstrate having just the following word "
- (change-start-delete)
- (with-style (:post-decoration #'decoration-strikethrough)
- "deleted")
- (change-end)
- ".")
-
-
- #||
(itemize (:text-style (:h-align :left :top-margin 3 :bottom-margin 4))
- (item () "This is the first item, and it's rather
+ (item () "This is the first item, and it's rather
long-winded. wjr aireg iureahg iureahg iureahg iureahg lrea hlieahg
eliurhg eliurhg eliurhg liureahglueairhg liurea hliure hgliueahg
liureahg liurea hgliureahg liureahg liureahg liureag realih."
- (itemize (:text-style (:top-margin 3 :bottom-margin 4) :item-fmt "- ")
- (item () "a" "1")
- (item () "b" "2")
- (item () "c")
- (item () "d")))
+ (itemize (:text-style (:top-margin 3 :bottom-margin 4) :item-fmt "- ")
+ (item () "a" "1")
+ (item () "b" "2")
+ (item () "c")
+ (item () "d")))
- (item () "This is the second item, and it's rather long-winded. wjr
+ (item () "This is the second item, and it's rather long-winded. wjr
aireg iureahg iureahg iureahg iureahg lrea hlieahg eliurhg eliurhg
eliurhg liureahglueairhg liurea hliure hgliueahg liureahg liurea
hgliureahg liureahg liureahg liureag realih."))
- :eop
+ (paragraph ()
+ "Start a new page:"
+ :eop)
- (make-ref-mark '(:chapter . 2) "Interesting Stuff")
+ (mark-ref-point '(:chapter . '(2)) :data "Interesting Stuff")
(paragraph (:font "Courier" :top-margin 3 :bottom-margin 4)
- (make-ref-mark "stuff")
- "Some" :eol "more" :eol "Text." )
+ (mark-ref-point "stuff")
+ "Some" :eol "more" :eol "Text." )
(paragraph (:h-align :left :top-margin 3 :bottom-margin 4)
- "This is linked to from page "
- (put-ref-page "link-from")
- ".")
- ||#
+ "KITTENS are mentioned on page "
+ (put-ref-point-page-number "KITTENS")
+ ".")
- (make-ref-mark "DocumentEnd"))))
+ (mark-ref-point "DocumentEnd"))))
+
+
More information about the cl-typesetting-devel
mailing list