Changeset 2848

Show
Ignore:
Timestamp:
04/02/08 11:08:32 (9 months ago)
Author:
ksprotte
Message:

some fixes to make-contract-tree

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/bos/web/contract-tree.lisp

    r2847 r2848  
    2424  ((output-images-size :initarg :output-images-size :accessor output-images-size))) 
    2525 
    26  
    2726(defun map-children-rects (function left top width-heights depth) 
    2827  "Calls FUNCTION with (x y width height depth) for each of the 
    …… 
    4645  (labels ((stick-on-last (list) 
    4746             (let* ((list (copy-list list)) 
    48                     (last list)) 
     47                    (last (last list))) 
    4948               (setf (cdr last) last) 
    5049               list)) 
    …… 
    7271                     (incf left w)))))) 
    7372           (children-setf-root (node &optional root) 
    74              (when root (setf (root node) root)) 
    75              (mapc #'(lambda (node) (children-setf-root node (if root root node))) (children node))) 
     73             (setf (root node) root) 
     74             (mapc #'(lambda (child) (children-setf-root child (if root root node))) (children node)) 
     75             node) 
    7676           (setf-root-slots (root) 
    7777             (setf (output-images-size root) output-images-size)