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

fixed *contract-tree-image-update-daemon* not to use destroy-thread

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 12:06:28 UTC (rev 3458) +++ trunk/projects/bos/web/contract-tree.lisp 2008-07-16 12:18:57 UTC (rev 3459) @@ -305,9 +305,12 @@

;; contract-tree image update daemon (defvar *contract-tree-image-update-daemon* nil) +(defvar *contract-tree-image-update-daemon-halt*)

(defun contract-tree-image-update-daemon-loop () - (loop (contract-tree-update-images-if-needed) (sleep 10))) + (loop (when *contract-tree-image-update-daemon-halt* (return)) + (contract-tree-update-images-if-needed) + (sleep 10)))

(defun contract-tree-image-update-daemon-running-p () (and *contract-tree-image-update-daemon* @@ -315,12 +318,14 @@

(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"))) + (setq *contract-tree-image-update-daemon-halt* nil) + (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))) + (when (contract-tree-image-update-daemon-running-p) + (setq *contract-tree-image-update-daemon-halt* t) + (warn "contract-tree-image-update-daemon will stop soon")))

;;; make-contract-tree-from-m2 (defun make-contract-tree-from-m2 ()