[cl-typesetting-devel] various extensions and bug fixes

Klaus Weidner kw at w-m-p.com
Sat Nov 6 23:01:58 UTC 2004


Hello,

diffs vs. v66 from the SVN repository:

kw-extensions.lisp |  611 ++++++++++++++++++++++++++++++++---------------------

- 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

cl-typesetting.asd |    2 

- kw-extensions depends on "top-level"

references.lisp    |    2 

- mark-ref-point was missing the "data" initializer.

boxes.lisp         |    4 

- 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.

pprint.lisp        |   13 -

- 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.

test.lisp          |    6 

- slightly more descriptive comment for running the complex example. 

6 files changed, 397 insertions(+), 241 deletions(-)

-Klaus
-------------- next part --------------
Index: cl-typesetting/cl-typesetting.asd
===================================================================
--- cl-typesetting/cl-typesetting.asd	(revision 66)
+++ cl-typesetting/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"))
 ;		 (:file "test" :depends-on ("top-level" "tables" "math"))
 		 (:file "pprint" :depends-on ("top-level"))
 		 )
Index: cl-typesetting/pprint.lisp
===================================================================
--- cl-typesetting/pprint.lisp	(revision 66)
+++ cl-typesetting/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)))
Index: cl-typesetting/kw-extensions.lisp
===================================================================
--- cl-typesetting/kw-extensions.lisp	(revision 66)
+++ cl-typesetting/kw-extensions.lisp	(working copy)
@@ -1,109 +1,97 @@
-;;; 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 *verbose* nil
+  "Print progress report while running.")
 
-(defun put-ref-page (id)
-  (put-string (format nil "~D" (ref-page id))))
+;; state for internal chapter handling
 
-(defgeneric ref-value (ref))
+(defvar *chapters* nil
+  "Ordered list of chapter information. For each chapter, contains
+reference and title. Example:
 
-(defmethod ref-value ((ref ref-mark))
-  (if ref (ref-mark-value ref)))
+ (((:chapter (1)) \"Intro\")
+  ((:chapter (1 1)) \"More stuff\"))")
 
-(defmethod ref-value ((id t))
-  (let ((ref (ref-get id)))
-    (if ref (ref-mark-value ref))))
+(defvar *chapter-nums* nil
+  "List of chapter numbers of current section, i.e. (1 2 3) for 1.2.3")
 
-(defun put-ref-value (id)
-  (put-string (ref-value id)))
+(defvar *change-bar-start* nil)
+(defvar *change-bar-end* nil)
 
-(defun this-page-number ()
-  pdf:*page-number*)
+;;; higher-level chapter number and table of contents handling
 
-(defun make-ref-page-mark (reftype value)
-  (make-ref-mark (cons reftype (incf *ref-counter*)) value))
+(defun chpnum-string (nums)
+  (format nil "~{~S~^.~}" nums))
 
-(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))))
+(defun chp-ref (level text)
+  "Insert a chapter reference into *chapters*, automatically
+incrementing the elements of *chapter-nums*"
+  (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 (list (cons :chapter *chapter-nums*) :data text)))
+    (push cs *chapters*)
+    cs))
 
-(defun current-ref-value (reftype)
-  (ref-value (get-latest-ref-to reftype (this-page-number))))
+(defun make-toc ()
+  "Generate table of contents from the information in *chapters*, to
+maximum depth *toc-depth*."
+  ;; FIXME: Indentation and font selection currently hardcoded
+  (mapcar (lambda (chp)
+	    ;; format table of contents entry
+	    (let* ((ref (first chp))
+		   (cnum (cdr ref))
+		   (depth (length cnum))
+		   (title (third 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*)))
 
-(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 layout
 
-(defmacro item ((&rest style) &body body)
-  `(with-style ,style , at body))
-
 (defun put-filled-string (string width &key (align :left))
   "place aligned string in fixed-width space"
   (let* ((string-width
@@ -117,22 +105,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 +201,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 +236,146 @@
 	      (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))
+
 ;; 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))
+			(file #P"/tmp/output.pdf")
+			(twosided *twosided*)
+			(paper-size *paper-size*))
   "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)))))))))
+  (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)))
+			  (if (and twosided (evenp pdf:*page-number*))
+			      (compile-text (:font "Times-Roman"
+						   :font-size 10
+						   :pre-decoration :none
+						   :post-decoration :none)
+				  
+					    (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
+						   :pre-decoration :none
+						   :post-decoration :none)
+				  
+					    (hbox (:align :center :adjustable-p t)
+						  (with-style (:font "Times-Italic")
+						    (put-string inside))
+						  :hfill
+						  (put-string outside))))))))
+	    
+	  (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 (:font "Times-Roman"
+						   :font-size 10
+						   :pre-decoration :none
+						   :post-decoration :none)
+				  
+					    (hbox (:align :center :adjustable-p t)
+						  (put-string outside)
+						  :hfill
+						  (put-string inside)))
+				
+			      (compile-text (:font "Times-Roman" :font-size 10 :pre-decoration :none :post-decoration :none)
+					    (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)))))
+      (draw-pages (eval (list 'compile-text () 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
+   '(with-style (:font "Times-Roman" :font-size 12
+		 :top-margin 3 :bottom-margin 4)
+     (set-contextual-variable :title "Titled Document")
+     (set-contextual-variable :version "Version 1.x")
+     (set-contextual-variable :header-enabled nil)
+     (set-contextual-variable :footer-enabled nil)
+		       
+     (set-contextual-variable :header-enabled t)
+     (set-contextual-variable :footer-enabled t)
+     
+     (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.")
+     
+     (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 +385,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 +405,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 +413,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)))
@@ -290,39 +434,26 @@
   (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)
-
-					#||
-     :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
-     ||#
+     (set-contextual-variable :title "Titled Document")
+     (set-contextual-variable :version "Version 1.x")
+     (set-contextual-variable :header-enabled nil)
+     (set-contextual-variable :footer-enabled nil)
 		       
-     (make-ref-page-mark :header-enabled t)
-     (make-ref-page-mark :footer-enabled t)
-     (make-ref-mark '(:chapter . 0) "Table of Contents")
+     (set-contextual-variable :header-enabled t)
+     (set-contextual-variable :footer-enabled t)
+     (mark-ref-point '(:chapter . '(0)) :data "Table of Contents")
      (with-style (:font "Helvetica")
        (paragraph (:h-align :left-but-last :top-margin 3 :bottom-margin 4)
-	 (put-ref-value '(:chapter . 1))
+	 (put-ref-point-value '(:chapter . '(1)))
 	 (dotted-hfill)
-	 (put-ref-page '(:chapter . 1)))
+	 (put-ref-point-page-number '(:chapter . '(1))))
        (paragraph (:h-align :left-but-last :top-margin 3 :bottom-margin 4)
-	 (put-ref-value '(:chapter . 2))
+	 (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-page '(:chapter . 2))))
-					#||
-     :eop
-     ||#
+	 (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")
@@ -332,41 +463,12 @@
 	 "italic")
        " text.")
 
-					#||
-     (paragraph (:h-align :left :top-margin 3 :bottom-margin 4)
-     (make-ref-mark "link-from")
-     "See also stuff on page "
-     (put-ref-page "stuff")
-     ".")
-     ||#
-
      (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)
-       "]")
+       "This paragraph has an undefined reference (see page " 
+      (put-ref-point-page-number "no-such-ref")
+      "), and mentions KITTENS."
+      (mark-ref-point "KITTENS"))
 
-     (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."))
-
-     (paragraph (:top-margin 3 :bottom-margin 4)
-       "This paragraph is not interesting.")
-
-
      (paragraph (:h-align :left :top-margin 3 :bottom-margin 4)
        "This paragraph has some "
        (change-start-insert)
@@ -391,35 +493,78 @@
 	 "deleted")
        (change-end)
        ".")
+
+     (paragraph (:top-margin 3 :bottom-margin 4)
+       "These are some "
+       (change-start-insert)
+       (set-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 "Times-Italic")
+	 "italic"
+	 (change-end)
+	 (set-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)
+       "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)
+       "Inline alignment test: ["
+       (put-filled-string "L" 30)
+       "]["
+       (put-filled-string "C" 30 :align :center)
+       "]["
+       (put-filled-string "R" 30 :align :right)
+       "]")
+
      (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
      
-     (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"))))
+
+
Index: cl-typesetting/test.lisp
===================================================================
--- cl-typesetting/test.lisp	(revision 66)
+++ cl-typesetting/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")
 
Index: cl-typesetting/boxes.lisp
===================================================================
--- cl-typesetting/boxes.lisp	(revision 66)
+++ cl-typesetting/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)
Index: cl-typesetting/references.lisp
===================================================================
--- cl-typesetting/references.lisp	(revision 66)
+++ cl-typesetting/references.lisp	(working copy)
@@ -28,7 +28,7 @@
 	  (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) data)
   (let* ((ref-point (gethash id *reference-table*)))
     (when (and ref-point (not (located-pass ref-point)))
       (error "Reference ~s is already defined " id))


More information about the cl-typesetting-devel mailing list