Revision: 3458 Author: ksprotte URL: http://bknr.net/trac/changeset/3458
added contract-tree image update daemon
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 11:59:12 UTC (rev 3457) +++ trunk/projects/bos/web/contract-tree.lisp 2008-07-16 12:06:28 UTC (rev 3458) @@ -303,6 +303,25 @@ :date (blob-timestamp image) :max-age 600)))))
+;; contract-tree image update daemon +(defvar *contract-tree-image-update-daemon* nil) + +(defun contract-tree-image-update-daemon-loop () + (loop (contract-tree-update-images-if-needed) (sleep 10))) + +(defun contract-tree-image-update-daemon-running-p () + (and *contract-tree-image-update-daemon* + (bt:thread-alive-p *contract-tree-image-update-daemon*))) + +(defun start-contract-tree-image-update-daemon () + (unless (contract-tree-image-update-daemon-running-p) + (bt:make-thread #'contract-tree-image-update-daemon-loop :name "contract-tree-image-update-daemon"))) + +(defun stop-contract-tree-image-update-daemon () + (when *contract-tree-image-update-daemon* + (bt:destroy-thread *contract-tree-image-update-daemon*) + (setq *contract-tree-image-update-daemon* nil))) + ;;; make-contract-tree-from-m2 (defun make-contract-tree-from-m2 () (setq *contract-tree* (make-instance 'contract-node @@ -314,7 +333,7 @@ (when (contract-published-p contract) (insert-contract *contract-tree* contract))) (format t "~&rendering contract-tree images if needed...") (force-output) - (contract-tree-update-images-if-needed) + (start-contract-tree-image-update-daemon) (format t "done.~%") (force-output) (geometry:register-rect-subscriber geometry:*rect-publisher* *contract-tree* (list 0 0 +width+ +width+)