[closure-cvs] CVS closure/src/gui

[dlichteblau]

Update of /project/closure/cvsroot/closure/src/gui
In directory clnet:/tmp/cvs-serv11810/src/gui

Modified Files:
	clim-gui.lisp clue-gui.lisp dce-and-pce.lisp 
Log Message:

Use Bordeaux Threads for all threading primitives, so that non-GUI parts of
Closure don't have to depend on CLIM anymore.

  - Removed all mp/ functions from glisp.

  - Use condition variables instead of process-wait.


--- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2006/12/31 13:26:23	1.26
+++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2006/12/31 15:42:40	1.27
@@ -4,7 +4,7 @@
 ;;;   Created: 2002-07-22
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: clim-gui.lisp,v 1.26 2006/12/31 13:26:23 emarsden Exp $
+;;;       $Id: clim-gui.lisp,v 1.27 2006/12/31 15:42:40 dlichteblau Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 2002 by Gilbert Baumann
 
@@ -28,6 +28,14 @@
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; $Log: clim-gui.lisp,v $
+;; Revision 1.27  2006/12/31 15:42:40  dlichteblau
+;; Use Bordeaux Threads for all threading primitives, so that non-GUI parts of
+;; Closure don't have to depend on CLIM anymore.
+;;
+;;   - Removed all mp/ functions from glisp.
+;;
+;;   - Use condition variables instead of process-wait.
+;;
 ;; Revision 1.26  2006/12/31 13:26:23  emarsden
 ;; - add basic wholine support (currently title & last-modified information)
 ;; - add "TeX mode On" and "TeX mode Off" commands (experimental)
@@ -445,7 +453,7 @@
 
 (defmacro with-closure (ignore &body body)
   (declare (ignore ignore))
-  `(clim-sys:with-lock-held (*closure-lock*)
+  `(clim-sys:with-recursive-lock-held (*closure-lock*)
     , at body))
 
 (defun parse-url* (url)
--- /project/closure/cvsroot/closure/src/gui/clue-gui.lisp	2006/12/31 11:48:18	1.5
+++ /project/closure/cvsroot/closure/src/gui/clue-gui.lisp	2006/12/31 15:42:40	1.6
@@ -41,7 +41,7 @@
 (in-package :clue-gui2)
 
 (defparameter *dcache* nil)
-(defparameter *dcache-lock* (mp/make-lock :name "dcache"))
+(defparameter *dcache-lock* (bordeaux-threads:make-lock "dcache"))
 
 (defparameter *pixmap-cache*
     nil)
--- /project/closure/cvsroot/closure/src/gui/dce-and-pce.lisp	2005/03/13 18:01:37	1.3
+++ /project/closure/cvsroot/closure/src/gui/dce-and-pce.lisp	2006/12/31 15:42:40	1.4
@@ -47,27 +47,28 @@
                             &key lazy-p callback)
   (let ((url (if (url:url-p url) (url:unparse-url url) url)))
     (let* ((dce
-            (mp/with-lock (*dcache-lock*)
+            (bordeaux-threads:with-recursive-lock-held (*dcache-lock*)
               (or
                (find-if (lambda (el)
                           (and (equal (dce-url el) url)
                                (eq (dce-presentation el) presentation)))
                         *dcache*)
-               (let ((new-dce (make-dce :url url
-                                        :presentation presentation
-                                        :data :work-in-progress
-                                        :lock (mp/make-lock :name "dce lock")))
-                     (flag nil))
-                 (r2::run-process-on-behalf-of-document
-                  document
-                  (lambda ()
-                    (mp/with-lock ((dce-lock new-dce))
-                      (setf flag t)
-                      (setf (dce-data new-dce)
-                            (dcache-generate-presentation presentation document url)) )))
-                 (mp/process-wait "foo"
-                                  (lambda () flag))
-                 (push new-dce *dcache*)
+               (let* ((lock (bordeaux-threads:make-lock "dce lock"))
+		      (new-dce (make-dce :url url
+					 :presentation presentation
+					 :data :work-in-progress
+					 :lock lock))
+		      (flag (bordeaux-threads:make-condition-variable)))
+                 (bordeaux-threads:with-recursive-lock-held (lock)
+		   (r2::run-process-on-behalf-of-document
+		    document
+		    (lambda ()
+		      (bordeaux-threads:with-recursive-lock-held (lock)
+			(bordeaux-threads:condition-notify flag)
+			(setf (dce-data new-dce)
+			      (dcache-generate-presentation presentation document url)) )))
+		   (bordeaux-threads:condition-wait flag lock)
+		   (push new-dce *dcache*))
                  new-dce)))))
       (if lazy-p
           (progn
@@ -75,10 +76,10 @@
              document
              (lambda ()
                (funcall callback
-                        (mp/with-lock ((dce-lock dce))
+                        (bordeaux-threads:with-recursive-lock-held ((dce-lock dce))
                           (dce-data dce)))))
             nil)
-          (mp/with-lock ((dce-lock dce))
+          (bordeaux-threads:with-recursive-lock-held ((dce-lock dce))
             (dce-data dce)) ))))
 
 (defmethod dcache-generate-presentation ((presentation (eql :aimage)) document url)