CLISP developers attitude. Was: [cl-typesetting-devel] CLISP support
Klaus Weidner
kw at w-m-p.com
Mon Apr 26 17:32:52 UTC 2004
On Mon, Apr 26, 2004 at 06:48:28PM +0200, Marc Battyani wrote:
> So do I wait for your new patches or do I put your last ones.
Please use the attached one, I slightly changed v-split to be closer to
the old code. I'm still not convinced that either this one or the old one
is correct regarding the slot-value dy update - this one assumes that
nobody cares about the table dy if the table fit completely, same as the
old one.
> Just note that your workaround will not work on the next release of CLISP as
> they are busy to patch it to be sure that it won't work!! This is truly
> amazing! I would have understood if they did nothing, but they are actually
> spending time to be sure that it won't work. When I think at the time we
> spent on this CLISP issue, I'm rather disgusted. Are you sure you need to
> use CLISP ? Otherwise I would put #+clisp (error "You should use another
> implementation")
It should work on the next clisp - the point of my most recent changes
was to remove the dependency on the platform-specific differences. If not
that needs to be fixed - hopefully we'll have moved to iterate by then.
Note that the new patch doesn't have any +clisp in it.
> He is happy to see that it will be the mess!
>
> [All this is public it's on the clisp-devel mailing list]
One thing that I do agree with him on is that it's a bad idea to depend
on the values of autostepped iteration values in the finally clause,
since that's not explicitly defined. The CLISP behavior IMHO actually
makes more sense than that of the MIT loop.
-Klaus
-------------- next part --------------
diff -urN -x *.fas -x *.lib orig/cl-typesetting/cl-typesetting.asd cl-typesetting/cl-typesetting.asd
--- orig/cl-typesetting/cl-typesetting.asd Thu Apr 22 05:23:18 2004
+++ cl-typesetting/cl-typesetting.asd Sun Apr 25 17:07:06 2004
@@ -6,7 +6,6 @@
(in-package asdf)
-#+(or allegro lispworks cmu sbcl openmcl mcl scl)
(defsystem :cl-typesetting
:name "cl-typesetting"
:author "Marc Battyani <marc.battyani at fractalconcept.com>"
diff -urN -x *.fas -x *.lib orig/cl-typesetting/tables.lisp cl-typesetting/tables.lisp
--- orig/cl-typesetting/tables.lisp Sun Apr 25 11:40:38 2004
+++ cl-typesetting/tables.lisp Mon Apr 26 12:25:14 2004
@@ -91,19 +91,10 @@
when (> i 1) ; set all but last rows unsplittable
do (setf (splittable-p row) nil)
do
- #-clisp
- (loop for j = 0 then (+ j (col-span c))
- and tail on (cells row)
- for c = (first tail) ; j is the column number of c
- while (< j col-number)
- collect (first tail) into head
- finally ; insert cell between head and tail
- (setf (cells row) (nconc head (list cell) tail)))
- #+clisp
(loop for j = 0 then (+ j (col-span c))
for tail = (cells row) then (cdr tail)
for c = (first tail) ; j is the column number of c
- while (and tail (< j col-number))
+ while (and c (< j col-number))
collect (first tail) into head
finally ; insert cell between head and tail
(setf (cells row) (nconc head (list cell) tail)))
@@ -114,34 +105,49 @@
(let ((full-size-offset (+ (border table) (* 2 (cell-padding table))))
(height (or (height row) +huge-number+)))
(loop with next-widths = (col-widths table)
- for width = (or (pop next-widths) 0) ; in case less elements specified
+
for cell in (cells row)
- for col-number = 0 then (+ col-number col-span 1)
- and col-span = (1- (col-span cell))
+ and width = (or (pop next-widths) 0) ; in case less elements specified
+ and col-number = 0 then (+ col-number col-span 1)
+ and cell-height = 0.0
+
+ for col-span = (1- (col-span cell))
and row-span = (row-span cell)
+
+ ;; Adjust cell width for cells spanning multiple columns
unless (zerop col-span)
do (incf width (+ (* col-span full-size-offset)
(reduce #'+ next-widths :end col-span)))
(setf next-widths (nthcdr col-span next-widths))
+
+ ;; Fill cell with content if required
when (cell-start-row-p cell row)
do (setf (box cell) (make-filled-vbox (content cell) width height)
(width cell) width)
+
;; A cell spanning several rows participates only in height calculation
;; of the last row
if (and (numberp row-span) (> row-span 1))
do (span-cell rows cell col-number)
else unless (height row)
if (eql row-span 1)
- maximize (compute-boxes-natural-size (boxes (box cell)) #'dy) into max-height
+ do (setq cell-height
+ (compute-boxes-natural-size (boxes (box cell)) #'dy))
else if (cell-end-row-p cell row)
- maximize (- (compute-boxes-natural-size (boxes (box cell)) #'dy)
- (reduce #'+ row-span
- :key #'height
- :end (1- (length row-span))
- :initial-value (* (1- (length row-span))
- full-size-offset))) into max-height
- finally (setf height (+ (max (or (height row) 0)
- #-clisp max-height #+clisp (or max-height 0)) +epsilon+)))
+ do (setq cell-height
+ (- (compute-boxes-natural-size (boxes (box cell)) #'dy)
+ (reduce #'+ row-span
+ :key #'height
+ :end (1- (length row-span))
+ :initial-value (* (1- (length row-span))
+ full-size-offset))))
+
+ maximize cell-height into max-height
+
+ finally (setf height (+ (max (or (height row) 0.0)
+ max-height)
+ +epsilon+)))
+
(setf (height row) height)
(loop for cell in (cells row)
for row-span = (row-span cell)
@@ -181,48 +187,59 @@
(dolist (row footer) (compute-row-size table row footer))))
(defmethod v-split ((table multi-page-table) dx dy &optional v-align)
- ;;; Factor out rows that fit and return as a first value.
- (with-slots (header footer rows-left) table
+ "Factor out rows that fit and return as a first value."
+ ;; Treat unsplittable rows as a single unit - for this purpose,
+ ;; group the rows-left list into the following form:
+ ;;
+ ;; ( (group1-height row1 row2 ...)
+ ;; (group2-height row7)
+ ;; (group3-height row8 row9 ...) )
+ ;;
+ (with-slots (header footer border padding cell-padding) table
(loop with boxes = ()
- with border = (border table)
- and padding = (padding table)
- and cell-padding = (cell-padding table)
- with full-size-offset = (+ cell-padding cell-padding border)
- with max-height = (- dy (reduce #'+ header :key #'dy) (reduce #'+ footer :key #'dy))
- for rows on rows-left
- and prev-y = 0 then y ; vertical space that has been output
- for row = (first rows)
- for y = (+ padding border (height row) full-size-offset)
- then (+ y (height row) full-size-offset)
- while (<= y max-height)
- ;do (setf (dy row) (+ (height row) full-size-offset))
- do (push row boxes)
- finally
- #+clisp (unless (> y max-height) (pop rows))
- (when (and boxes
- ;; Trim unsplitalbe rows and reverse the list of accumulated boxes
- (setf boxes
- #-clisp
- (loop for tail on boxes
- for row = (first tail)
- until (splittable-p row)
- do (decf prev-y (+ (height row) full-size-offset))
- finally (return (nreverse tail)))
- #+clisp
- (loop for tail = boxes then (cdr tail)
- for row = (first tail)
- until (or (not row) (splittable-p row))
- do (decf prev-y (+ (height row) full-size-offset))
- finally (return (nreverse tail)))))
- (setq boxes (append header boxes footer))
+ with header+footer-height = (+ (reduce #'+ header :key #'dy)
+ (reduce #'+ footer :key #'dy))
+ with current-height = (+ border padding)
+ with available-height = (- dy header+footer-height)
+ with row-groups = (loop with height = 0
+ and rows = ()
+
+ for row in (rows-left table)
+
+ do
+ (incf height (+ (height row)
+ (* 2 cell-padding)
+ border))
+ (push row rows)
+
+ when (splittable-p row)
+ collect (cons height (nreverse rows))
+ and do (setf height 0 rows nil))
+ with rows-remaining = (rows-left table)
+
+ for (group-height . rows) in row-groups
+ while (<= (+ current-height group-height) available-height)
+
+ do (dolist (r rows)
+ (push r boxes)
+ (pop rows-remaining))
+ (incf current-height group-height)
+
+ finally
+ (when boxes
+ (setq boxes (append header (nreverse boxes) footer))
+ ;; reduce rows to output
+ (setf (rows-left table) rows-remaining)
+ ;; reduce space required by table (don't subtract header/footer)
+ (decf (slot-value table 'dy) current-height)
(let ((first (first boxes))
(last (first (last boxes))))
(setf (slot-value first 'position) :first
(slot-value last 'position) (if (eq first last) :single :last)))
- (setf rows-left rows) ; reduce rows to output
- (decf (slot-value table 'dy) prev-y) ; and space required by table
- (return (values boxes rows (- max-height prev-y))))
- (return (values nil rows-left dy)))))
+ (return (values boxes
+ rows-remaining
+ (- dy current-height header+footer-height))))
+ (return (values nil rows-remaining dy)))))
(defmethod dy :around ((table multi-page-table))
(with-slots (header footer) table
More information about the cl-typesetting-devel
mailing list