anchor.diff:  ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
   ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
   
  -;; $Id: gdk.lisp,v 1.38 2007-06-01 09:17:17 espen Exp $
  +;; $Id: gdk.lisp,v 1.39 2007-06-18 12:23:05 espen Exp $
   
   
   (in-package "GDK")
  
positive.code: 
  ;;; Multi-threading support
  
  #+sbcl
  (progn
    (defvar *global-lock* (sb-thread:make-mutex :name "global GDK lock"))
    (let ((recursive-level 0))
      (defun threads-enter ()
        (if (eq (sb-thread:mutex-value *global-lock*) sb-thread:*current-thread*)
  	  (incf recursive-level)
   	(sb-thread:get-mutex *global-lock*)))
  
      (defun threads-leave (&optional flush-p)
        (cond
         ((zerop recursive-level)	  
  	(when flush-p
  	  (display-flush))
  	(sb-thread:release-mutex *global-lock*))
         (t (decf recursive-level)))))
  
    (define-callback %enter-fn nil ()
      (threads-enter))
  
negative.code:     `(progn
         (threads-enter)
         (unwind-protect
  	   (progn ,@body)
  	 (threads-leave t))))
  
    (defun timeout-add-with-lock (interval function &optional (priority +priority-default+))
      (timeout-add interval
       #'(lambda () 
  	 (with-global-lock (funcall function)))
       priority))
  
    (defun idle-add-with-lock (funcation &optional (priority +priority-default-idle+))
      (idle-add 
       #'(lambda () 
  	 (with-global-lock (funcall function)))
       priority)))
  
  
  #-sb-thread
  (progn
    (defmacro with-global-lock (&body body)
      `(progn ,@body))
  
    (defun timeout-add-with-lock (interval function &optional (priority +priority-default+))
      (timeout-add interval function priority))
  
    (defun idle-add-with-lock (funcation &optional (priority +priority-default-idle+))
      (idle-add function priority)))
  
  
  