From marc.battyani at fractalconcept.com Tue Nov 2 09:21:32 2004 From: marc.battyani at fractalconcept.com (Marc Battyani) Date: Tue, 2 Nov 2004 10:21:32 +0100 Subject: [cl-typesetting-devel] Q: Reference points absolute coordinates? References: <000401c4bc54$5233ae90$4c4d02c3@digo> Message-ID: <07c101c4c0bd$58a2e940$0a02a8c0@marcxp> Dmitri Ivanov wrote: > Is it possible to find the absolute coordinates of a ref-point on the page? > How can I get absolute top or bottom of a table row, e.g. > > (tt:table (:col-widths (100 200)) > (tt:row () > (tt:mark-ref-point 'ref-point1) > (tt:cell () (tt:p () "test11")) > (tt:cell (:v-align :center) (tt:p () "test12"))) > (tt:row () > (tt:mark-ref-point 'ref-point2) > (tt:cell () (tt:p () "test21")) > (tt:cell (:v-align :center) (tt:p () "test22")))) > > (let ((ref-point1 (tt:find-ref-point 'ref-point1)) > (ref-point2 (tt:find-ref-point 'ref-point2))) > (format t "~%ref-point1 y = ~s, ref-point2 y = ~s" > (tt::y ref-point1) (tt::y ref-point2))) > ; prints the save value for both Generally it's not possible as an arbitrary transformation can be there. If you just want to go up one level, that is getting the top-left coordinates of the cell in the document referential it should be possible to modify stroke table to put the stroke of the cell content outside the pdf:translate thus staying in the document referential. Marc From divanov at aha.ru Wed Nov 3 16:57:54 2004 From: divanov at aha.ru (Dmitri Ivanov) Date: Wed, 3 Nov 2004 19:57:54 +0300 Subject: [cl-typesetting-devel] Q: Reference points absolute coordinates? References: <000401c4bc54$5233ae90$4c4d02c3@digo> <07c101c4c0bd$58a2e940$0a02a8c0@marcxp> Message-ID: <000001c4c1c6$f4d8a2a0$7d4302c3@digo> Hello Marc, |> Is it possible to find the absolute coordinates of a ref-point on the |> page? | Generally it's not possible as an arbitrary transformation can be | there. If you just want to go up one level, that is getting the | top-left coordinates of the cell in the document referential it should | be possible to modify stroke table to put the stroke of the cell | content outside the pdf:translate thus staying in the document | referential. As we have the specials *table* and *table-row* anyhow, I suggest binding them inside stroke-table, e.g. (defun stroke-table (table x y rows dy) (let* ((*table* table)) ... (loop ... for row in (append (header table) rows (footer table)) for row-y = (- y padding border) then (- row-y height full-size-offset) and height = (height row) and *table-row* = row ... )) That could facilitate computing absolute cell coordinates via add-contextual-action, e.g. (let ((row-heights ())) (tt:compile-text () (tt:mark-ref-point 'table-top) (tt:table (:col-widths '(100 150)) (tt:row (:height min-row-height) (tt:cell () ... (tt:add-contextual-action (lambda () (push (+ (tt::height tt::*table-row*) (* 2 (tt::cell-padding tt::*table*))))) row-heights)))) ...)))) -- Sincerely, Dmitri Ivanov lisp.ystok.ru From peter at javamonkey.com Wed Nov 3 17:57:32 2004 From: peter at javamonkey.com (Peter Seibel) Date: Wed, 03 Nov 2004 09:57:32 -0800 Subject: [cl-typesetting-devel] Memory problems generating big docs? Message-ID: When I try to generate a PDF of my whole book ~150,000 words/400 pages in Allegro (Enterprise 6.2 on GNU/Linux) I completely run out of memory--Allegro can't get any more from the system. I'm going to mail support at Franz for help debugging this but I was wondering if anyone here had any ideas about a) what I can change in my usage of cl-typesetting to use less memory b) changes that can be made to cl-typesetting itself to use less memory. -Peter -- Peter Seibel peter at javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp From peter at javamonkey.com Wed Nov 3 19:33:56 2004 From: peter at javamonkey.com (Peter Seibel) Date: Wed, 03 Nov 2004 11:33:56 -0800 Subject: [cl-typesetting-devel] Memory problems generating big docs? In-Reply-To: (Peter Seibel's message of "Wed, 03 Nov 2004 09:57:32 -0800") References: Message-ID: Peter Seibel writes: > When I try to generate a PDF of my whole book ~150,000 words/400 pages > in Allegro (Enterprise 6.2 on GNU/Linux) I completely run out of > memory--Allegro can't get any more from the system. I'm going to mail > support at Franz for help debugging this but I was wondering if anyone > here had any ideas about a) what I can change in my usage of > cl-typesetting to use less memory b) changes that can be made to > cl-typesetting itself to use less memory. FWIW, I tried using SBCL 0.8.16 (after fixing a few compilation problems in cl-typesetting--patches to follow) and, while a bit slower than Allegro, it did manage to generate a 412 page PDF of my book. -Peter -- Peter Seibel peter at javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp From marc.battyani at fractalconcept.com Wed Nov 3 19:52:45 2004 From: marc.battyani at fractalconcept.com (Marc Battyani) Date: Wed, 3 Nov 2004 20:52:45 +0100 Subject: [cl-typesetting-devel] Q: Reference points absolute coordinates? References: <000401c4bc54$5233ae90$4c4d02c3@digo><07c101c4c0bd$58a2e940$0a02a8c0@marcxp> <000001c4c1c6$f4d8a2a0$7d4302c3@digo> Message-ID: <0e0d01c4c1de$b192e0b0$0a02a8c0@marcxp> "Dmitri Ivanov" wrote: Hi Dmitri, > As we have the specials *table* and *table-row* anyhow, I suggest binding > them inside stroke-table, e.g. Good idea. I will do it. Marc From marc.battyani at fractalconcept.com Wed Nov 3 19:52:52 2004 From: marc.battyani at fractalconcept.com (Marc Battyani) Date: Wed, 3 Nov 2004 20:52:52 +0100 Subject: [cl-typesetting-devel] Memory problems generating big docs? References: Message-ID: <0e0e01c4c1de$b5710540$0a02a8c0@marcxp> > Peter Seibel writes: > > > When I try to generate a PDF of my whole book ~150,000 words/400 pages > > in Allegro (Enterprise 6.2 on GNU/Linux) I completely run out of > > memory--Allegro can't get any more from the system. I'm going to mail > > support at Franz for help debugging this but I was wondering if anyone > > here had any ideas about a) what I can change in my usage of > > cl-typesetting to use less memory b) changes that can be made to > > cl-typesetting itself to use less memory. > > FWIW, I tried using SBCL 0.8.16 (after fixing a few compilation > problems in cl-typesetting--patches to follow) and, while a bit slower > than Allegro, it did manage to generate a 412 page PDF of my book. Have you tried with LW ? These days, I routinely generate a 1300+ page document with no problem with LW. It conses a lot and takes 15min (on a P4 2.2GHz laptop) but finishes A profiling/optimization phase would be useful though. Marc From peter at javamonkey.com Wed Nov 3 20:18:39 2004 From: peter at javamonkey.com (Peter Seibel) Date: Wed, 03 Nov 2004 12:18:39 -0800 Subject: [cl-typesetting-devel] Memory problems generating big docs? In-Reply-To: <0e0e01c4c1de$b5710540$0a02a8c0@marcxp> (Marc Battyani's message of "Wed, 3 Nov 2004 20:52:52 +0100") References: <0e0e01c4c1de$b5710540$0a02a8c0@marcxp> Message-ID: "Marc Battyani" writes: >> Peter Seibel writes: >> >> > When I try to generate a PDF of my whole book ~150,000 words/400 pages >> > in Allegro (Enterprise 6.2 on GNU/Linux) I completely run out of >> > memory--Allegro can't get any more from the system. I'm going to mail >> > support at Franz for help debugging this but I was wondering if anyone >> > here had any ideas about a) what I can change in my usage of >> > cl-typesetting to use less memory b) changes that can be made to >> > cl-typesetting itself to use less memory. >> >> FWIW, I tried using SBCL 0.8.16 (after fixing a few compilation >> problems in cl-typesetting--patches to follow) and, while a bit slower >> than Allegro, it did manage to generate a 412 page PDF of my book. > > Have you tried with LW ? I have not. -Peter -- Peter Seibel peter at javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp From kw at w-m-p.com Wed Nov 3 21:01:18 2004 From: kw at w-m-p.com (Klaus Weidner) Date: Wed, 3 Nov 2004 15:01:18 -0600 Subject: [cl-typesetting-devel] Memory problems generating big docs? In-Reply-To: References: Message-ID: <20041103210118.GA5160@w-m-p.com> On Wed, Nov 03, 2004 at 09:57:32AM -0800, Peter Seibel wrote: > When I try to generate a PDF of my whole book ~150,000 words/400 pages > in Allegro (Enterprise 6.2 on GNU/Linux) I completely run out of > memory--Allegro can't get any more from the system. I'm going to mail > support at Franz for help debugging this but I was wondering if anyone > here had any ideas about a) what I can change in my usage of > cl-typesetting to use less memory b) changes that can be made to > cl-typesetting itself to use less memory. Using "clisp" has worked well for me, and was faster than sbcl/cmucl on some crude tests I did with less memory used. Probably that's because it has a fairly simple but fast compiler, and the bulk of the typesetting work seems to be macro expansion. -Klaus From divanov at aha.ru Sat Nov 6 06:12:20 2004 From: divanov at aha.ru (Dmitri Ivanov) Date: Sat, 6 Nov 2004 09:12:20 +0300 Subject: [cl-typesetting-devel] Individual table cell borders enhancement Message-ID: <000a01c4c3c7$bdf2ca10$4a4d02c3@digo> Hello, The code attached facilitates entering individual borders for each table cell separately. The border slot should be given a quad specifying thickness values. The cell border is being drawn between table border and cell padding. Borders of a cell count for its external height (unless it is limited by the height of the containing row) and tighten the width of its content box. Hence, they participate in the calculation of total row or table height, but do not increase column width. General border drawing was also improved by taking into account the fact that lines go through the middle of the points. The sample code is included at the bottom of the tables.lisp file inside the #| |# comment. Please test and enjoy. -- Sincerely, Dmitri Ivanov lisp.ystok.ru -------------- next part -------------- A non-text attachment was scrubbed... Name: tables.zip Type: application/x-zip-compressed Size: 5256 bytes Desc: not available URL: From divanov at aha.ru Sat Nov 6 06:59:11 2004 From: divanov at aha.ru (Dmitri Ivanov) Date: Sat, 6 Nov 2004 09:59:11 +0300 Subject: [cl-typesetting-devel] Re: Individual table cell borders enhancement Message-ID: <001101c4c3ce$ca1b42c0$4a4d02c3@digo> Hello once again, Second thoughts are best, sorry. -- Sincerely, Dmitri Ivanov lisp.ystok.ru -------------- next part -------------- A non-text attachment was scrubbed... Name: tables.zip Type: application/x-zip-compressed Size: 5255 bytes Desc: not available URL: From marc.battyani at fractalconcept.com Sat Nov 6 14:52:06 2004 From: marc.battyani at fractalconcept.com (Marc Battyani) Date: Sat, 6 Nov 2004 15:52:06 +0100 Subject: [cl-typesetting-devel] Individual table cell borders enhancement References: <000a01c4c3c7$bdf2ca10$4a4d02c3@digo> Message-ID: <16f301c4c410$2ff12470$0a02a8c0@marcxp> "Dmitri Ivanov" wrote: > The code attached facilitates entering individual borders for each table > cell separately. > > The border slot should be given a quad specifying thickness values. The cell > border is being drawn between table border and cell padding. Borders of a > cell count for its external height (unless it is limited by the height of > the containing row) and tighten the width of its content box. Hence, they > participate in the calculation of total row or table height, but do not > increase column width. > > General border drawing was also improved by taking into account the fact > that lines go through the middle of the points. > > The sample code is included at the bottom of the tables.lisp file inside the > #| |# comment. > > Please test and enjoy. Hi Dmitri, Congratulations for this very useful addition! I will look at this. Marc From kw at w-m-p.com Sat Nov 6 23:01:58 2004 From: kw at w-m-p.com (Klaus Weidner) Date: Sat, 6 Nov 2004 17:01:58 -0600 Subject: [cl-typesetting-devel] various extensions and bug fixes Message-ID: <20041106230158.GB23619@w-m-p.com> 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)) From kw at w-m-p.com Sat Nov 6 23:30:09 2004 From: kw at w-m-p.com (Klaus Weidner) Date: Sat, 6 Nov 2004 17:30:09 -0600 Subject: [cl-typesetting-devel] XML render extensions Message-ID: <20041106233009.GA27891@w-m-p.com> Hello, [this didn't make it to the list, second try without as many attachments. Get the example file here: http://www-106.ibm.com/developerworks/library/x-xslfo2app/everything.html ] I've attached the XHTML renderer I'd been working on as an example of using the "kw-extensions" routines. I'm not sure if it makes sense to integrate this in cl-typesetting since it introduces a dependency on the xmls parser module. Maybe something for a contrib/ directory? Bill Clementson has also worked on XML transforms, but I haven't looked at his code yet: http://home.comcast.net/~bc19191/blog/041103.html -Klaus -------------- next part -------------- (in-package typeset) ;; (asdf::use :cl-typesetting :xmls) ;; For prettier printing of XHTML output at the REPL, use with: ;; (setf (readtable-case *readtable*) :invert) (defun char-invert-case (c) (if (upper-case-p c) (char-downcase c) (char-upcase c))) (defun invert-if-single-case (s) (if (and (some #'upper-case-p s) (some #'lower-case-p s)) s (map 'string #'char-invert-case s))) (defun xml-make-keyword (s) (if (symbolp s) s (intern (invert-if-single-case (substitute #\! #\: s)) "KEYWORD"))) ;; XML trees must be of the form (elem attr . content), with attr ;; being a list of (key . value) conses, and content being a list of ;; strings and XML trees. There should be no consecutive strings or ;; empty strings in the content list. ;; ;; Example: a bold link ;; ==> ;; (:a ((:href . "http://example.com") (:title . "Example")) "a " (:b () "bold") " link") ;; Accessor functions (defun xml-elem (tree) (car tree)) (defun xml-attr (tree) (cadr tree)) (defun xml-clst (tree) (cddr tree)) (defun xml-attr-get (attr key) (cdr (assoc key attr))) (defun xml-xform (elem-xform tree &optional parents) "Recursively transform XML tree depth-first by calling the supplied elem-xform function on each node." (declare (function elem-xform)) (let ((clst (mapcar (lambda (c) (if (consp c) ;; recurse into content (xml-xform elem-xform c (cons c parents)) c)) (xml-clst tree)))) (funcall elem-xform (nconc (list (xml-elem tree) (xml-attr tree)) clst) parents))) (defun xml-collapse-sxml-namespace (node parents) "Remove namespace information from XML tree, and use keyword symbols for elements and attributes. Example: (\"foo\" . \"http://namespace\") => :foo" (declare (ignorable parents)) (let ((elem (xml-elem node)) (attr (xml-attr node)) (clst (xml-clst node))) (declare (ignorable elem attr clst)) (nconc (list (if (consp elem) (xml-make-keyword (car elem)) (xml-make-keyword elem)) (mapcar (lambda (a) (cons (if (consp (car a)) (xml-make-keyword (cdar a)) (xml-make-keyword (car a))) (cdr a))) attr)) clst))) (defun string-collapse-whitespace (string) (do* ((chars (map 'list #'identity (substitute #\Space #\NewLine string)) (cdr chars)) (c (car chars) (car chars)) (new nil)) ((null chars) (map 'string #'identity (nreverse new))) (unless (and (eql c #\Space) (eql (car new) #\Space)) (push c new)))) (defun verbatim-p (parents) (find-if (lambda (p) (or (member (xml-elem p) '(:pre :ins :del)) ;; FIXME: assumes that if the attribute was ;; specified, that it has the value "false"... (assoc :white-space-collapse (xml-attr p)))) parents)) (defun remove-spaces (clst) (remove-if (lambda (c) (or (null c) (equal c " "))) clst)) (defun remove-leading-space (clst) (if (equal " " (car clst)) (cdr clst) clst)) (defun xml-collapse-whitespace (node parents) (declare (ignorable parents)) (let ((elem (xml-elem node)) (attr (xml-attr node)) (clst (xml-clst node))) (declare (ignorable elem attr clst)) (nconc (list elem attr) (if (verbatim-p (cons node parents)) clst ;; keep unmodified for this element (remove-leading-space (mapcar (lambda (c) (if (stringp c) (string-collapse-whitespace c) c)) clst)))))) (defun attr-list-to-assoc (node parents) "convert sxml (attr val) list to (attr . val) conses" (declare (ignorable parents)) (let ((elem (xml-elem node)) (attr (xml-attr node)) (clst (xml-clst node))) (declare (ignorable elem attr clst)) (nconc (list elem (mapcar (lambda (a) (cons (car a) (cadr a))) attr)) clst))) (defun xml-extract-text (tree) "Extract text strings from XML file." (let ((clst (xml-clst tree)) (strings nil)) (dolist (c clst) (cond ((stringp c) (push c strings)) ((consp c) (push (xml-extract-text c) strings)))) (apply #'concatenate 'string (reverse strings)))) ;; Note: load-xml-file can't handle non-XML files. ;; ;; The following command is useful to convert legacy HTML ;; to parseable XMTHL: ;; ;; tidy -wrap 0 -asxhtml SLES-security-guide.html (defun load-xml-file (file) ;;setq xmls::*entities* ;;(adjoin '("AElig;" #\?) xmls::*entities* :test #'equal)) ;;setq xmls::*entities* ;;(adjoin '("sect;" #\#) xmls::*entities* :test #'equal)) ;;setq xmls::*entities* ;;(adjoin '("nbsp;" #\Space) xmls::*entities* :test #'equal)) (with-open-file (s file) (let ((xml (xmls:parse s :compress-whitespace nil))) (xml-xform #'attr-list-to-assoc xml)))) (defun flatten-mostly (tree) "Similar to flatten, but keep the last level of list structure intact." (let ((acc nil)) (labels ((rec (tree) (cond ((null tree) nil) ((or (atom tree) (atom (car tree))) (push tree acc)) (t (rec (car tree)) (rec (cdr tree)))))) (rec tree) (nreverse acc)))) (defun xml-subtrees (path tree) "Returns list of all subtrees matching path spec. Example: (xml-subtrees '(:body :h1) tree)" ;; FIXME: This should be simpler... (flatten-mostly (cond ((null tree) nil) ((null path) tree) (t (mapcar (lambda (c) (xml-subtrees (cdr path) c)) (remove-if-not (lambda (c) (and (consp c) (eq (xml-elem c) (car path)))) (xml-clst tree))))))) (defun xml-subtree (path tree) "Returns first subtree matching path spec. Example: (xml-subtrees tree '(:body :h1))" (car (xml-subtrees path tree))) (defun xhtml-get-body (tree) "Extract the body from an XHTML file." (xml-subtree tree '(:html :body))) (defmacro appendq (var &rest lists) `(setf ,var (append ,var , at lists))) (defmacro append1 (var &rest elems) `(setf ,var (append ,var (list , at elems)))) ;; misc utilities (defun remove-if-not-elems (elst clst) (remove-if-not (lambda (c) (and (consp c) (member elst (xml-elem c)))) clst)) (defun remove-if-not-elem (elem clst) (remove-if-not (lambda (c) (and (consp c) (eq elem (xml-elem c)))) clst)) ;;(defun xmls::resolve-entity (ent) ;; "Resolves the xml entity ENT to a character. Numeric entities are ;;converted using CODE-CHAR, which only works in implementations that ;;internally encode strings in US-ASCII, ISO-8859-1 or UCS." ;; (declare (type simple-base-string ent)) ;; (or (and (>= (length ent) 2) ;; (char= (char ent 0) #\#) ;; (code-char ;; (min 255 ;; (if (char= (char ent 1) #\x) ;; (parse-integer ent :start 2 :end (- (length ent) 1) :radix 16) ;; (parse-integer ent :start 1 :end (- (length ent) 1)))))) ;; (second (assoc ent xmls::*entities* :test #'string=)) ;; (warn "Unable to resolve entity ~S" ent) ;; #\?)) (defun table-cell-p (c) (and (consp c) (eq (car c) 'cell))) (defun column-count (rows) (iter (for row in rows) (maximize (count-if #'table-cell-p row)))) (defun calculate-column-widths (colspec rows) (print colspec) (mapcar (lambda (l) (declare (ignorable l)) (/ 420 (column-count rows))) rows)) ;; 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)) (clst (xml-clst node))) ;; Deal with each element recursively. (case elem ((:html) `(with-style () , at clst)) ((: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 ((:title) node) ;; tricky elements that involve cross-reference handling ((: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 :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 (mark-ref-point "DocumentEnd")))) ((:a) ;; FIXME: make links clickable (let ((name (xml-attr-get attr :name)) (href (xml-attr-get attr :href)) (out nil)) (if name (append1 out `(mark-ref-point ,name))) (appendq out clst) (if href (append1 out (if (eql #\# (aref href 0)) `(put-string (format nil " (page ~D)" (find-ref-point-page-number ,(subseq href 1)))) `(with-style () " (" (with-style (:color :blue) (put-string ,href)) ")")))) `(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)) ((:p) `(paragraph (:font *font-normal* :font-size 10 :top-margin 3 :bottom-margin 4) , at clst)) ;; Table support is currently very limited ((:table) `(table (:col-widths ',(calculate-column-widths (xml-attr-get attr :cols) clst)) , at clst)) ((:tr) `(row () , at clst)) ((:td :th) (let* ((col-span (or (xml-attr-get attr :colspan) "1")) (row-span (or (xml-attr-get attr :rowspan) "1")) (align-s (xml-attr-get attr :align)) (align (cond ((equal align-s "right") :right) ((equal align-s "center") :center) (t :left)))) `(cell (:col-span ,(parse-integer col-span) :row-span ,(parse-integer row-span)) (paragraph (:h-align ,align) , at clst)))) ;; Ordered lists are a bit tricky, need to handle the item ;; numbering correctly. The following should support most ;; interesting parts of the XHTML spec. ((:ul) ;; FIXME: support different bullet styles `(itemize (:item-fmt "- " :text-style (:top-margin 3 :bottom-margin 4)) ,@(remove-if-not-elem 'item clst))) ((:ol) (let* ((first (or (xml-attr-get attr :start) "1")) (type (xml-attr-get attr :type)) (fmt (cond ((equal type "I") "~@R ") ((equal type "i") "~(~@R~) ") ((equal type "A") "~/tt::alpha-item/. ") ((equal type "a") "~:/tt::alpha-item/. ") (t "~D. ")))) `(itemize (:item-fmt ,fmt :start-from ,(parse-integer first) :text-style (:top-margin 3 :bottom-margin 4)) ,@(remove-if-not-elem 'item clst)))) ((:li) `(item () , at clst)) ;; most elements are straightforward transformations ((:dl) `(with-style () , at clst)) ((:dt) `(paragraph (:font *font-bold* :bottom-margin 0) , at clst)) ((:dd) `(paragraph (:top-margin 0 :left-margin 20 :bottom-margin 7) , at clst)) ((:center) `(paragraph (:font *font-normal* :font-size 10 :top-margin 3 :bottom-margin 4 :h-align :center) , at clst)) ((:blockquote) `(paragraph (:font *font-normal* :font-size 10 :top-margin 3 :bottom-margin 4 :left-margin 20 :right-margin 20) , at clst)) ((:pre :code) `(with-style (:font *font-monospace* :font-size 9 :bottom-margin 0) ,@(mapcar (lambda (c) `(verbatim ,c)) clst))) ((:nobr) `(with-style () (hbox () , at clst))) ((:br) :eol) ((:div :span) `(with-style () , at clst)) ((:i :em :var :address) ;; FIXME: can't handle bold-italic `(with-style (:font *font-italic*) , at clst)) ((:b :strong) ;; FIXME: can't handle bold-italic `(with-style (:font *font-bold*) , at clst)) ((:tt :kbd :samp) `(with-style (:font *font-monospace*) , at clst)) ((:big) `(with-style (:font-size (* *font-size* 1.2)) , at clst)) ((:small) `(with-style (:font-size (/ *font-size* 1.2)) , at clst)) ((:cite) `(with-style () , at clst)) ((:sub) `(with-subscript (:font-size (* 0.75 *font-size*)) , at clst)) ((:sup) `(with-superscript (:font-size (* 0.75 *font-size*)) , at clst)) ((:u) `(with-style (:post-decoration #'decoration-underline) , at clst)) ((:strike) `(with-style (:post-decoration #'decoration-strikethrough) , at clst)) ((:hr) `(hrule :dy 0.5)) ;; change bar support ((:ins) `(with-style (:pre-decoration #'decoration-green-background) (change-start-insert) ,@(if (verbatim-p parents) (mapcar (lambda (c) `(verbatim ,c)) clst) clst) (change-end))) ((:del) `(with-style (:post-decoration #'decoration-strikethrough) (change-start-delete) ,@(if (verbatim-p parents) (mapcar (lambda (c) `(verbatim ,c)) clst) clst) (change-end))) ;; non-standard extension: unnested change start/stop markers. ;; ;; They need to be used pairwise (in tree depth-first order), ;; but do NOT need to be properly nested in relation to other ;; XHTML elements. This makes it much easier to generate diffs ;; with a non-XML-aware tool such as wdiff. ;; ;; Example: ;; - This is text ;; + This is some bold text ;; -> ;; This is some bold text ((:ins-start) `(set-style (:pre-decoration #'decoration-green-background) (change-start-insert))) ((:del-start) `(set-style (:post-decoration #'decoration-strikethrough) (change-start-delete))) ((:ins-end :del-end) `(set-style (:pre-decoration :none :post-decoration :none) (change-end))) ;; Unknown item: insert bright and ugly complaint (otherwise `(with-style (:color :red) "[Unsupported: " ,(symbol-name elem) "]"))))) ;;; high-level functions (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))))) ;; Generate table of contents #-(and) (setq *chapters* (mapcar (lambda (h) (xml-extract-text h)) (xml-subtrees '(:body :h1) tree))) ;; The tree-to-tree transform (xml-xform #'typeset-elem-xform tree))) (defun xhtml-to-pdf (input output) (typeset::render-document (xhtml-to-typeset input) :file output :twosided *twosided*)) ;; following sections help in building a command line tool (based on ;; clisp) to convert HTML to PDF #+clisp (defun save-image () (ext:gc) (ext:saveinitmem "clisp-xml-render.mem" :init-function #'tt::run :start-package (find-package :tt))) ;; gzip -9 clisp-xml-render.mem && mv clisp-xml-render.mem.gz ~/lisp/images/clisp/ ;; ship with /usr/lib/clisp/full/lisp.run binary #+clisp (defun run () (let ((args ext:*ARGS*)) (when (equal "-x" (first args)) (eval (read-from-string (second args))) (setq args (cddr args))) (if (eql 2 (length args)) (apply #'xhtml-to-pdf args) (format *error-output* "~&Usage: html2pdf INPUT.html OUTPUT.pdf"))) (ext:exit)) ;; Test case: ;; (tt::xhtml-to-pdf "everything.html" "/tmp/output.pdf") -------------- next part -------------- ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;; How to use this: ;; ;; Get Marc Battyani's "cl-typesetting" and "cl-pdf" packages: ;; http://www.fractalconcept.com/asp/html/cl-typesetting.html ;; ;; and Miles Egan's xmls parser: ;; http://common-lisp.net/project/xmls/ ;; ;; Then load this package and use as follows: ;; (tt::xhtml-to-pdf "everything.html" "/tmp/output.pdf") ;; ;; If you have clisp, you may want to use the included shell script ;; "html2pdf" for command line use. Read the script comments for more details. (in-package :asdf) (defsystem :xml-render :name "xml-render" :author "Klaus Weidner " :version "2.1.1" :maintainer "Klaus Weidner " :licence "BSD like license" :description "none" :long-description "" :perform (load-op :after (op xml-render) (pushnew :xml-render cl:*features*)) :components ((:file "xml-xform")) :depends-on (:cl-typesetting :xmls)) -------------- next part -------------- #!/bin/sh # # Convert HTML documents to PDF # # Copyright (C) 2004 Klaus Weidner # # Permission is hereby granted, free of charge, to any person obtaining a copy # of this software and associated documentation files (the "Software"), to deal # in the Software without restriction, including without limitation the rights # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell # copies of the Software, and to permit persons to whom the Software is # furnished to do so, subject to the following conditions: # # The above copyright notice and this permission notice shall be included in # all copies or substantial portions of the Software. # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE # SOFTWARE. # Configure this to point to the location of the saved memory image. # Generate it as follows: # # clisp -x "(asdf::oos 'asdf:load-op :xml-render) (tt::save-image)" # gzip -9 clisp-xml-render.mem # mv clisp-xml-render.mem.gz ~/lisp/images/clisp # IMAGE="$HOME/lisp/images/clisp/clisp-xml-render.mem.gz" # Location of GNU CLISP binary #CLISP=/usr/lib/clisp/full/lisp.run CLISP=clisp # WARNING: creates fixed-name temp files in current working directory. # Don't use it if current dir is writable for untrusted users. # Run through W3C "tidy" utility to clean up noncompliant HTML and # convert to XHTML. See http://tidy.sourceforge.net/ # # Not needed if input is already valid XHTML. Comment out the next # 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 () { echo "Usage: $(basename $0) FILE.html Creates FILE.pdf in current working directory." >&2 exit 1 } [ $# -eq 1 ] || Usage IN="$1" OUT=$(basename "$IN" .html).pdf if [ -x "$TIDY" ] then XML=$(basename "$IN").tmp.xhtml "$TIDY" --quiet yes --show-warnings 0 -wrap 0 -asxhtml "$IN" > "$XML" else XML="$IN" fi # Do the conversion $CLISP -q -q -M $IMAGE -- "$XML" "$OUT" [ -x "$TIDY" ] && rm -f "$XML" [ -x "$PDFTK" ] && { "$PDFTK" "$OUT" output "$OUT.new" compress && mv "$OUT.new" "$OUT" } From marc.battyani at fractalconcept.com Sun Nov 7 00:31:41 2004 From: marc.battyani at fractalconcept.com (Marc Battyani) Date: Sun, 7 Nov 2004 01:31:41 +0100 Subject: [cl-typesetting-devel] XML render extensions References: <20041106233009.GA27891@w-m-p.com> Message-ID: <181901c4c461$27746db0$0a02a8c0@marcxp> "Klaus Weidner" wrote: Hi Klaus, > [this didn't make it to the list, second try without as many attachments. > Get the example file here: > http://www-106.ibm.com/developerworks/library/x-xslfo2app/everything.html > ] > > I've attached the XHTML renderer I'd been working on as an example of > using the "kw-extensions" routines. Great! I will look at this (and at your diffs) tomorow. > I'm not sure if it makes sense to integrate this in cl-typesetting since > it introduces a dependency on the xmls parser module. Maybe something for > a contrib/ directory? Yes. A contrib and/or examples directory would be a good idea. Marc From Bill_Clementson at peoplesoft.com Sun Nov 7 00:48:57 2004 From: Bill_Clementson at peoplesoft.com (Bill_Clementson at peoplesoft.com) Date: Sat, 6 Nov 2004 17:48:57 -0700 Subject: [cl-typesetting-devel] XML render extensions Message-ID: --- Klaus Weidner wrote: > Bill Clementson has also worked on XML transforms, > but I haven't looked > at his code yet: > http://home.comcast.net/~bc19191/blog/041103.html My code is not specific to cl-typesetting (and it also has dependencies on XMLS, LML2, and KMRCL), so it wouldn't make sense to add it to the cl-typesetting contrib/ directory. -- Bill Clementson From peter at javamonkey.com Mon Nov 8 21:58:52 2004 From: peter at javamonkey.com (Peter Seibel) Date: Mon, 08 Nov 2004 13:58:52 -0800 Subject: [cl-typesetting-devel] Some small patches Message-ID: Here are some patches that I've had lying around in my version of cl-typesetting that allow it to compile cleanly on some of the more picky Common Lisp's. 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/hyphenation-fp.lisp =================================================================== --- cl-typesetting/hyphenation-fp.lisp (revision 66) +++ cl-typesetting/hyphenation-fp.lisp (working copy) @@ -293,8 +293,8 @@ (setf (exception-trie hyphen-trie) (hyphen-make-trie exceptions 0)) )) -(setf *american-hyphen-trie* (make-instance 'hyphen-trie :language :american)) -(setf *french-hyphen-trie* (make-instance 'hyphen-trie :language :french)) +(defparameter *american-hyphen-trie* (make-instance 'hyphen-trie :language :american)) +(defparameter *french-hyphen-trie* (make-instance 'hyphen-trie :language :french)) (read-hyphen-file *american-hyphen-trie*) (read-hyphen-file *french-hyphen-trie*) -- Peter Seibel peter at javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp From peter at javamonkey.com Mon Nov 8 22:03:50 2004 From: peter at javamonkey.com (Peter Seibel) Date: Mon, 08 Nov 2004 14:03:50 -0800 Subject: [cl-typesetting-devel] Some small patches In-Reply-To: (Peter Seibel's message of "Mon, 08 Nov 2004 13:58:52 -0800") References: Message-ID: Peter Seibel writes: > Here are some patches that I've had lying around in my version of > cl-typesetting that allow it to compile cleanly on some of the more > picky Common Lisp's. Oh, another problem I had when compiling with with SBCL was that the iterate source files are in DOS mode which causes ~ format directives to fail since they look to Lisp like ~ which isn't a valid format directive. I worked around it by dos2unix'ing the files but I don't know if there's a better long term solution? Does subversion have any facility to fix line endings for text files so folks who check them out onto Unix machines get Unix line endings and Windows folks get Windows CRLFs? -Peter > > > 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/hyphenation-fp.lisp > =================================================================== > --- cl-typesetting/hyphenation-fp.lisp (revision 66) > +++ cl-typesetting/hyphenation-fp.lisp (working copy) > @@ -293,8 +293,8 @@ > (setf (exception-trie hyphen-trie) (hyphen-make-trie exceptions 0)) > )) > > -(setf *american-hyphen-trie* (make-instance 'hyphen-trie :language :american)) > -(setf *french-hyphen-trie* (make-instance 'hyphen-trie :language :french)) > +(defparameter *american-hyphen-trie* (make-instance 'hyphen-trie :language :american)) > +(defparameter *french-hyphen-trie* (make-instance 'hyphen-trie :language :french)) > (read-hyphen-file *american-hyphen-trie*) > (read-hyphen-file *french-hyphen-trie*) > > > -- > Peter Seibel peter at javamonkey.com > > Lisp is the red pill. -- John Fraser, comp.lang.lisp > > _______________________________________________ > cl-typesetting-devel site list > cl-typesetting-devel at common-lisp.net > http://common-lisp.net/mailman/listinfo/cl-typesetting-devel > -- Peter Seibel peter at javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp From marc.battyani at fractalconcept.com Mon Nov 8 22:25:14 2004 From: marc.battyani at fractalconcept.com (Marc Battyani) Date: Mon, 8 Nov 2004 23:25:14 +0100 Subject: [cl-typesetting-devel] Some small patches References: Message-ID: <00cc01c4c5e1$d1923530$0a02a8c0@marcxp> "Peter Seibel" wrote: > Peter Seibel writes: > > > Here are some patches that I've had lying around in my version of > > cl-typesetting that allow it to compile cleanly on some of the more > > picky Common Lisp's. > > Oh, another problem I had when compiling with with SBCL was that the > iterate source files are in DOS mode which causes ~ format > directives to fail since they look to Lisp like ~ > which isn't a valid format directive. I worked around it by > dos2unix'ing the files but I don't know if there's a better long term > solution? Does subversion have any facility to fix line endings for > text files so folks who check them out onto Unix machines get Unix > line endings and Windows folks get Windows CRLFs? Thanks for the patches. I try to look at them tomorrow (in the plane to Milano ;-). The crlf problem in the iterate sources has already annoyed some people. I will get the latest iterate version and check in what format are the files. That's cool, There is a lot of new stuff to integrate. Thanks to all! :) Marc From kw at w-m-p.com Mon Nov 8 22:29:06 2004 From: kw at w-m-p.com (Klaus Weidner) Date: Mon, 8 Nov 2004 16:29:06 -0600 Subject: [cl-typesetting-devel] Some small patches In-Reply-To: References: Message-ID: <20041108222906.GB4310@w-m-p.com> On Mon, Nov 08, 2004 at 02:03:50PM -0800, Peter Seibel wrote: > Oh, another problem I had when compiling with with SBCL was that the > iterate source files are in DOS mode which causes ~ format > directives to fail since they look to Lisp like ~ > which isn't a valid format directive. I worked around it by > dos2unix'ing the files but I don't know if there's a better long term > solution? Does subversion have any facility to fix line endings for > text files so folks who check them out onto Unix machines get Unix > line endings and Windows folks get Windows CRLFs? Yes, if the "svn:eol-style" property is set to "native" for the source files, subversion will autoconvert in the way you describe. That's a property in the repository. svn propset svn:eol-style native */*.lisp For new files, you can set this in $HOME/.subversion/config so that they get marked automatically: enable-auto-props = yes [auto-props] *.lisp = svn:eol-style=native (You can also set the property to "LF", "CRLF", or "CR" if you need the file to have a specific line ending convention.) -Klaus From kw at w-m-p.com Mon Nov 8 22:38:24 2004 From: kw at w-m-p.com (Klaus Weidner) Date: Mon, 8 Nov 2004 16:38:24 -0600 Subject: [cl-typesetting-devel] Some small patches In-Reply-To: References: <20041108223458.GC4310@w-m-p.com> Message-ID: <20041108223824.GD4310@w-m-p.com> On Mon, Nov 08, 2004 at 01:58:52PM -0800, Peter Seibel wrote: > -(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) FYI, that one was also included in the patches I had sent. I'm currently looking into a weird effect, the PDF files generated by current cl-pdf versions are getting rejected as invalid by the "pdftk" tool. Older versions used to work fine. I'll try to track down what the difference is. -Klaus From peter at javamonkey.com Mon Nov 8 23:06:22 2004 From: peter at javamonkey.com (Peter Seibel) Date: Mon, 08 Nov 2004 15:06:22 -0800 Subject: [cl-typesetting-devel] Some small patches In-Reply-To: <00cc01c4c5e1$d1923530$0a02a8c0@marcxp> (Marc Battyani's message of "Mon, 8 Nov 2004 23:25:14 +0100") References: <00cc01c4c5e1$d1923530$0a02a8c0@marcxp> Message-ID: "Marc Battyani" writes: > "Peter Seibel" wrote: >> Peter Seibel writes: >> >> > Here are some patches that I've had lying around in my version of >> > cl-typesetting that allow it to compile cleanly on some of the more >> > picky Common Lisp's. >> >> Oh, another problem I had when compiling with with SBCL was that the >> iterate source files are in DOS mode which causes ~ format >> directives to fail since they look to Lisp like ~ >> which isn't a valid format directive. I worked around it by >> dos2unix'ing the files but I don't know if there's a better long term >> solution? Does subversion have any facility to fix line endings for >> text files so folks who check them out onto Unix machines get Unix >> line endings and Windows folks get Windows CRLFs? > > Thanks for the patches. I try to look at them tomorrow (in the plane > to Milano ;-). The crlf problem in the iterate sources has already > annoyed some people. I will get the latest iterate version and check > in what format are the files. > > That's cool, There is a lot of new stuff to integrate. Thanks to > all! :) Another heads up--there's a problem in Allegro 7.0 that stops it from compiling pprint.lisp (due to it's use of ITERATE). I believe it's a bug in Allegro and have opened a ticket with them. But if anyone needs a quick workaround this patch seems to do the trick: Index: iterate.lisp =================================================================== --- iterate.lisp (revision 66) +++ iterate.lisp (working copy) @@ -627,7 +627,7 @@ ;; functions; and, by personal preference, special operators ;; should be expanded before iterate clauses. - ((macro-function (car form) *env*) + ((macro-form? (car form) *env*) (walk (macroexpand form *env*))) ((special-form? (car form)) (walk-special-form form)) @@ -727,6 +727,14 @@ (or (special-operator-p symbol) (assoc symbol *special-form-alist*))) +(defun macro-form? (symbol &optional env) + ;; Workaround to deal with seeming bug in Allegro 7.0 where DECLARE + ;; has a MACRO-FUNCTION but MACROEXPANDING it goes into an infinite + ;; loop. + (when (not (eql symbol 'cl:declare)) + (macro-function symbol env))) + + (defun walk-special-form (form) (let* ((*clause* form) (func-p (assoc (car form) *special-form-alist*)) @@ -963,7 +971,7 @@ (let ((args (cons (keywordize (first ppclause)) (cdr ppclause))) (func (clause-info-function info))) - (if (macro-function func *env*) + (if (macro-form? func *env*) (walk (macroexpand (cons func args) *env*)) (apply-clause-function func args)))) (t @@ -2020,7 +2028,7 @@ (nconc free-vars (free-vars-list body bound-vars)))) (otherwise nil))) - ((macro-function (car form) *env*) + ((macro-form? (car form) *env*) (free-vars (macroexpand form *env*) bound-vars)) (t ; function call (free-vars-list (cdr form) bound-vars)))) -Peter -- Peter Seibel peter at javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp From kw at w-m-p.com Mon Nov 8 23:15:07 2004 From: kw at w-m-p.com (Klaus Weidner) Date: Mon, 8 Nov 2004 17:15:07 -0600 Subject: [cl-typesetting-devel] PATCH: 'creator' invalid syntax In-Reply-To: <20041108223824.GD4310@w-m-p.com> References: <20041108223458.GC4310@w-m-p.com> <20041108223824.GD4310@w-m-p.com> Message-ID: <20041108231507.GA9707@w-m-p.com> On Mon, Nov 08, 2004 at 04:38:24PM -0600, Klaus Weidner wrote: > I'm currently looking into a weird effect, the PDF files generated by > current cl-pdf versions are getting rejected as invalid by the "pdftk" > tool. Older versions used to work fine. I'll try to track down what the > difference is. Found it, the "creator" property was being written in invalid syntax (key and value need to alternate): Was: << /Creator cl-pdf (cl-pdf 2.03) >> should be: << /Creator (cl-pdf 2.03) >> Acroread also complains when trying to view the document properties, so it's not just pdftk that was finicky. It was caused by a misplaced ~a in a format string. The attached patch fixes it, and also sets the default "creator" entry to include the version number. This permits users to override the "creator" value and not be forced to always have the version number appended, which I assume was not the intention. BTW, Marc, what's your preferred format for patches? Are MIME attachments ok or would you prefer inline patches? And would you prefer the patches to be split into separate files whenever possible or are combined patches ok as long as they are reasonably simple? A simple "svn diff" is easiest for me but I can split them up in case I'm working on multiple things in parallel. -Klaus -------------- next part -------------- Index: pdf.lisp =================================================================== --- pdf.lisp (revision 66) +++ pdf.lisp (working copy) @@ -62,7 +62,7 @@ (subject :accessor subject :initarg :subject :initform nil))) (defmethod initialize-instance :after ((doc document) &rest init-options - &key (creator "cl-pdf") empty author title subject keywords + &key (creator (format nil "cl-pdf ~A" *version*)) empty author title subject keywords &allow-other-keys) (declare (ignore init-options)) (unless empty @@ -78,7 +78,7 @@ ("/Pages" . ,(root-page doc))))) (setf (content (docinfo doc)) (make-instance 'dictionary - :dict-values `(("/Creator" . ,(format nil "~a (cl-pdf ~A)" creator *version*)) + :dict-values `(("/Creator" . ,(format nil "(~A)" creator)) ,@(when author `(("/Author" . ,(format nil "(~A)" author)))) ,@(when title `(("/Title" . ,(format nil "(~A)" title)))) ,@(when subject `(("/Subject" . ,(format nil "(~A)" subject)))) From peter at javamonkey.com Mon Nov 8 23:57:12 2004 From: peter at javamonkey.com (Peter Seibel) Date: Mon, 08 Nov 2004 15:57:12 -0800 Subject: [cl-typesetting-devel] Best way to inline an image Message-ID: What's the best way to generate inline images generated with cl-pdf in a cl-typeset document? Looking at test.lisp I see user-drawn-demo and draw-pie. One uses draw-block and the other pdf:draw-object. For simplicity I just want to inline diagrams centered with no text flowing around them. -Peter -- Peter Seibel peter at javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp From peter at javamonkey.com Tue Nov 9 02:25:07 2004 From: peter at javamonkey.com (Peter Seibel) Date: Mon, 08 Nov 2004 18:25:07 -0800 Subject: [cl-typesetting-devel] Best way to inline an image In-Reply-To: (Peter Seibel's message of "Mon, 08 Nov 2004 15:57:12 -0800") References: Message-ID: Peter Seibel writes: > What's the best way to generate inline images generated with cl-pdf in > a cl-typeset document? Looking at test.lisp I see user-drawn-demo and > draw-pie. One uses draw-block and the other pdf:draw-object. For > simplicity I just want to inline diagrams centered with no text > flowing around them. Okay, I figured it out. user-drawn-box and a function that emits foo does the trick. -Peter -- Peter Seibel peter at javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp From peter at javamonkey.com Wed Nov 10 05:01:25 2004 From: peter at javamonkey.com (Peter Seibel) Date: Tue, 09 Nov 2004 21:01:25 -0800 Subject: [cl-typesetting-devel] Iterate patch Message-ID: So the problem I mentioned with iterate.lisp and Allegro 7.0 seems to be something that could arguably be considered a bug in ITERATE. At any rate it's not going to be fixed in Allegro any time soon. This patch fixes it. Also that problem I had with running out of memory when generating a 400+ page document in Allegro 6.2 went away in 7.0 for whatever that's worth. -Peter Index: iterate/iterate.lisp =================================================================== --- iterate/iterate.lisp (revision 66) +++ iterate/iterate.lisp (working copy) @@ -627,7 +627,7 @@ ;; functions; and, by personal preference, special operators ;; should be expanded before iterate clauses. - ((macro-function (car form) *env*) + ((macro-form? (car form) *env*) (walk (macroexpand form *env*))) ((special-form? (car form)) (walk-special-form form)) @@ -727,6 +727,16 @@ (or (special-operator-p symbol) (assoc symbol *special-form-alist*))) +(defun macro-form? (symbol &optional env) + ;; Workaround to deal with Allegro 7.0 where DECLARE has a + ;; MACRO-FUNCTION but MACROEXPANDING it goes into an infinite loop. + ;; Arguably this is rightous in any implementation because a DECLARE + ;; expression is not a form and MACROEXPAND's argumnet is supposed + ;; to be a form. + (when (not (eql symbol 'cl:declare)) + (macro-function symbol env))) + + (defun walk-special-form (form) (let* ((*clause* form) (func-p (assoc (car form) *special-form-alist*)) @@ -963,7 +973,7 @@ (let ((args (cons (keywordize (first ppclause)) (cdr ppclause))) (func (clause-info-function info))) - (if (macro-function func *env*) + (if (macro-form? func *env*) (walk (macroexpand (cons func args) *env*)) (apply-clause-function func args)))) (t @@ -2020,7 +2030,7 @@ (nconc free-vars (free-vars-list body bound-vars)))) (otherwise nil))) - ((macro-function (car form) *env*) + ((macro-form? (car form) *env*) (free-vars (macroexpand form *env*) bound-vars)) (t ; function call (free-vars-list (cdr form) bound-vars)))) -- Peter Seibel peter at javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp From alemmens at xs4all.nl Wed Nov 10 07:05:44 2004 From: alemmens at xs4all.nl (Arthur Lemmens) Date: Wed, 10 Nov 2004 08:05:44 +0100 Subject: [cl-typesetting-devel] Iterate patch In-Reply-To: References: Message-ID: Peter Seibel wrote: > So the problem I mentioned with iterate.lisp and Allegro 7.0 seems to > be something that could arguably be considered a bug in ITERATE. At > any rate it's not going to be fixed in Allegro any time soon. I reported a problem with iterate on Allegro 7.0 beta to Andreas Fuchs on the iterate mailing list a few weeks ago. Andreas came up with a fix almost immediately. By the looks of your patch, it seems to have been the same problem. Regards, Arthur Lemmens From kw at w-m-p.com Wed Nov 10 15:22:22 2004 From: kw at w-m-p.com (Klaus Weidner) Date: Wed, 10 Nov 2004 09:22:22 -0600 Subject: [cl-typesetting-devel] Iterate patch In-Reply-To: References: Message-ID: <20041110152222.GA563@w-m-p.com> On Wed, Nov 10, 2004 at 08:05:44AM +0100, Arthur Lemmens wrote: > Peter Seibel wrote: > > >So the problem I mentioned with iterate.lisp and Allegro 7.0 seems to > >be something that could arguably be considered a bug in ITERATE. At > >any rate it's not going to be fixed in Allegro any time soon. > > I reported a problem with iterate on Allegro 7.0 beta to Andreas Fuchs > on the iterate mailing list a few weeks ago. Andreas came up with a fix > almost immediately. By the looks of your patch, it seems to have been > the same problem. Is this problem due to the presence of ignore-errors inside iter? clisp refused to compile that. The patch I had sent Saturday worked around that problem by moving the ignore-errors construct into a separate function. But fixing the iterate code is of course the better long term solution. -Klaus From alemmens at xs4all.nl Wed Nov 10 15:55:19 2004 From: alemmens at xs4all.nl (Arthur Lemmens) Date: Wed, 10 Nov 2004 16:55:19 +0100 Subject: [cl-typesetting-devel] Iterate patch In-Reply-To: <20041110152222.GA563@w-m-p.com> References: <20041110152222.GA563@w-m-p.com> Message-ID: Klaus Weidner wrote: > Is this problem due to the presence of ignore-errors inside iter? I forgot the exact details, but I don't think so. It had something to do with COND not being recognized as a macro (or as a special form), so that ITERATE entered a recursive loop that it never get out of. I suppose the iterate mailing list archive at common-lisp.net can tell you the exact details if you're interested, but I don't have time to look this up myself at the moment (I'm fighting a deadline). Arthur From marc.battyani at fractalconcept.com Wed Nov 10 16:08:25 2004 From: marc.battyani at fractalconcept.com (Marc Battyani) Date: Wed, 10 Nov 2004 17:08:25 +0100 Subject: [cl-typesetting-devel] Iterate patch References: <20041110152222.GA563@w-m-p.com> Message-ID: <052e01c4c73f$82c174c0$0a02a8c0@marcxp> "Arthur Lemmens" wrote: > Klaus Weidner wrote: > > > Is this problem due to the presence of ignore-errors inside iter? > > I forgot the exact details, but I don't think so. It had something to > do with COND not being recognized as a macro (or as a special form), > so that ITERATE entered a recursive loop that it never get out of. > > I suppose the iterate mailing list archive at common-lisp.net can > tell you the exact details if you're interested, but I don't have > time to look this up myself at the moment (I'm fighting a deadline). You too...Only one ? ;-) Cheers, Marc From alemmens at xs4all.nl Wed Nov 10 17:48:26 2004 From: alemmens at xs4all.nl (Arthur Lemmens) Date: Wed, 10 Nov 2004 18:48:26 +0100 Subject: [cl-typesetting-devel] Iterate patch In-Reply-To: <052e01c4c73f$82c174c0$0a02a8c0@marcxp> References: <20041110152222.GA563@w-m-p.com> <052e01c4c73f$82c174c0$0a02a8c0@marcxp> Message-ID: Marc Battyani wrote: >> (I'm fighting a deadline). > > You too...Only one ? Three, actually ;-) (The first one is tomorrow.) Arthur From divanov at aha.ru Thu Nov 11 07:02:54 2004 From: divanov at aha.ru (Dmitri Ivanov) Date: Thu, 11 Nov 2004 10:02:54 +0300 Subject: [cl-typesetting-devel] Iterate patch References: <20041110152222.GA563@w-m-p.com> Message-ID: <000201c4c7bc$e8bbd720$824302c3@digo> Hello, Excuse my interrupting, but I personally biased against the idea of adding a new considerable package to the project without a real need. That often leads to more mess and unforeseen troubleshooting, sigh :-( -- Sincerely, Dmitri Ivanov lisp.ystok.ru From marc.battyani at fractalconcept.com Thu Nov 11 21:17:57 2004 From: marc.battyani at fractalconcept.com (Marc Battyani) Date: Thu, 11 Nov 2004 22:17:57 +0100 Subject: [cl-typesetting-devel] Iterate patch References: <20041110152222.GA563@w-m-p.com> <000201c4c7bc$e8bbd720$824302c3@digo> Message-ID: <0a0001c4c833$eb011320$0a02a8c0@marcxp> "Dmitri Ivanov" wrote: > Excuse my interrupting, but I personally biased against the idea of adding a > new considerable package to the project without a real need. > That often leads to more mess and unforeseen troubleshooting, sigh :-( I have already been hit by some modifications, in several open sources packages, that introduced either bugs or incompatibilities. So now every library I use is in my repositories just to be in sync with my code. That way if I want to go back to some earlier version, I get all the libraries in sync. In the case of ITERATE, I was thinking of moving it to the same level than cl-pdf and cl-typesetting in the repository. Marc From peter at javamonkey.com Sat Nov 27 23:56:45 2004 From: peter at javamonkey.com (Peter Seibel) Date: Sat, 27 Nov 2004 15:56:45 -0800 Subject: [cl-typesetting-devel] Losing formatting across page break. Message-ID: I seem to recall having a problem like this a long time ago that got fixed. But some remnant of it seems to still be with us. I have this method which I used to typeset code in my book, both blocks of code and inline code snippets. (defmethod emit-pdf-by-type ((type (eql 'text-parser::code)) children) (let ((*no-mdash* t)) (typeset::with-style (:font "Courier") (dolist (c children) (emit-pdf c))))) Anyway, in one of my chapters I have a name "make-cd" that is typeset with this formatting and got broken across a page after the dash. The first part of the name, "make-", is properly formatted, in Courier but the second part, "cd", reverts to the default font. Is this some bad interaction with the hyphenation code? Or something else? Anyway, if nobody know right away what's up with this I'll try to put together a test case when I get a chance. -Peter -- Peter Seibel peter at javamonkey.com Lisp is the red pill. -- John Fraser, comp.lang.lisp From marc.battyani at fractalconcept.com Mon Nov 29 22:10:45 2004 From: marc.battyani at fractalconcept.com (Marc Battyani) Date: Mon, 29 Nov 2004 23:10:45 +0100 Subject: [cl-typesetting-devel] Losing formatting across page break. References: Message-ID: <033d01c4d660$4752a6e0$0a02a8c0@marcxp> "Peter Seibel" wrote: > I seem to recall having a problem like this a long time ago that got > fixed. But some remnant of it seems to still be with us. I have this > method which I used to typeset code in my book, both blocks of code > and inline code snippets. > > (defmethod emit-pdf-by-type ((type (eql 'text-parser::code)) children) > (let ((*no-mdash* t)) > (typeset::with-style (:font "Courier") > (dolist (c children) (emit-pdf c))))) > > Anyway, in one of my chapters I have a name "make-cd" that is typeset > with this formatting and got broken across a page after the dash. The > first part of the name, "make-", is properly formatted, in Courier but > the second part, "cd", reverts to the default font. Is this some bad > interaction with the hyphenation code? Or something else? Anyway, if > nobody know right away what's up with this I'll try to put together a > test case when I get a chance. Yes, a test case would be great. BTW I still have to include the stuff that you, Klaus and Dmitri sent to me. I also made some modifications and fixes and I hope to be able to find some time to work on this. Right now I have to correct a problem in tables when the content of a cell is huge. The table line is rejected to the next page but as the header line is there, there is no "too big to fit" error and it generates a few millions pages like that before dying.... :( Marc From kw at w-m-p.com Tue Nov 30 00:51:43 2004 From: kw at w-m-p.com (Klaus Weidner) Date: Mon, 29 Nov 2004 18:51:43 -0600 Subject: [cl-typesetting-devel] various extensions and bug fixes Message-ID: <20041130005143.GF6713@w-m-p.com> 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")))) + + From marc.battyani at fractalconcept.com Tue Nov 30 22:58:29 2004 From: marc.battyani at fractalconcept.com (Marc Battyani) Date: Tue, 30 Nov 2004 23:58:29 +0100 Subject: [cl-typesetting-devel] various extensions and bug fixes References: <20041130005143.GF6713@w-m-p.com> Message-ID: <090501c4d730$1cfbc2c0$0a02a8c0@marcxp> "Klaus Weidner" wrote: > 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. Cool! I'm applying your patches right now (and all the other patches and code I've got also). So far so good. I will test and commit all that tomorow :) Marc