Revision: 3457 Author: ksprotte URL: http://bknr.net/trac/changeset/3457

contract-tree new function (contract-tree-update-images-if-needed) that now is very fast in the case that there are no updates to be done

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

Modified: trunk/projects/bos/web/contract-tree.lisp =================================================================== --- trunk/projects/bos/web/contract-tree.lisp 2008-07-16 10:20:49 UTC (rev 3456) +++ trunk/projects/bos/web/contract-tree.lisp 2008-07-16 11:59:12 UTC (rev 3457) @@ -268,12 +268,26 @@ (delete-file (blob-pathname old-store-image)) (delete-object old-store-image)))))))

+(defun contract-node-update-image-needed-p (node) + (or (null (image node)) + (> (timestamp node) (blob-timestamp (image node))))) + (defun contract-node-update-image-if-needed (node) - (when (or (null (image node)) - (not (probe-file (blob-pathname (image node)))) - (> (timestamp node) (blob-timestamp (image node)))) + (when (contract-node-update-image-needed-p node) (contract-node-update-image node)))

+(defun contract-tree-update-images-if-needed () + ;; I did not see an easy way to avoid that + ;; CONTRACT-NODE-UPDATE-IMAGE-NEEDED-P is called twice for every + ;; node. Once inside CONTRACT-NODE-UPDATE-IMAGE-IF-NEEDED and once + ;; for the prune-test. + + ;; Let's hope we are lucky and there is nothing to do by inspecting + ;; *contract-tree* at first only once. + (when (contract-node-update-image-needed-p *contract-tree*) + (map-nodes #'contract-node-update-image-if-needed *contract-tree* + :prune-test (lambda (node) (not (contract-node-update-image-needed-p node)))))) + ;;; image handler (defclass contract-tree-image-handler (page-handler) ()) @@ -300,7 +314,7 @@ (when (contract-published-p contract) (insert-contract *contract-tree* contract))) (format t "~&rendering contract-tree images if needed...") (force-output) - (map-nodes #'contract-node-update-image-if-needed *contract-tree*) + (contract-tree-update-images-if-needed) (format t "done.~%") (force-output) (geometry:register-rect-subscriber geometry:*rect-publisher* *contract-tree* (list 0 0 +width+ +width+)