X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/470805d14a3b04477540e7d0ab5291b542e4921f..8f49b7a10a9717890ca98dff2b01799b80ce2761:/gdk/gdk.lisp

diff --git a/gdk/gdk.lisp b/gdk/gdk.lisp
index a02267e..f3ec462 100644
--- a/gdk/gdk.lisp
+++ b/gdk/gdk.lisp
@@ -20,7 +20,7 @@
 ;; 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.45 2007-10-17 18:04:47 espen Exp $
+;; $Id: gdk.lisp,v 1.50 2008-04-21 16:21:07 espen Exp $
 
 
 (in-package "GDK")
@@ -44,7 +44,7 @@
 	 (display-name display) (pointer-address (foreign-location display))))
     (call-next-method)))
 
-(defbinding %display-open () display
+(defbinding %display-open () (or null display)
   (display-name (or null string)))
 
 (defvar *display-aliases* ())
@@ -102,11 +102,11 @@
 (defbinding flush () nil)
 
 (defbinding display-get-event
-    (&optional (display (display-get-default))) event
+    (&optional (display (display-get-default))) (or null event)
   (display display))
 
 (defbinding display-peek-event
-    (&optional (display (display-get-default))) event
+    (&optional (display (display-get-default))) (or null event)
   (display display))
 
 (defbinding display-put-event
@@ -149,7 +149,7 @@
 
 ;;; Display manager
 
-(defbinding display-get-default () display)
+(defbinding display-get-default () (or null display))
 
 (defbinding (display-set-default "gdk_display_manager_set_default_display")
     (display) nil
@@ -303,14 +303,14 @@
 
 (defbinding (events-pending-p "gdk_events_pending") () boolean)
 
-(defbinding event-get () event)
+(defbinding event-get () (or null event))
 
-(defbinding event-peek () event)
+(defbinding event-peek () (or null event))
 
 (defbinding event-get-graphics-expose () event
   (window window))
 
-(defbinding event-put () event
+(defbinding event-put () nil
   (event event))
 
 ;(defbinding event-handler-set () ...)
@@ -415,7 +415,9 @@
 (defbinding window-destroy () nil
   (window window))
 
-(defbinding window-at-pointer () window
+(defbinding (window-at-pointer "gdk_display_get_window_at_pointer") 
+    (&optional (display (display-get-default))) (or null window)
+  display
   (x int :out)
   (y int :out))
 
@@ -735,7 +737,7 @@
   (x int :out)
   (y int :out))
 
-(defbinding window-get-pointer () window
+(defbinding window-get-pointer () (or null window)
   (window window)
   (x int :out)
   (y int :out)
@@ -999,22 +1001,20 @@
 
 (defbinding %draw-layout () nil
   (drawable drawable) (gc gc) 
-  (font pango:font)
   (x int) (y int)
   (layout pango:layout))
 
 (defbinding %draw-layout-with-colors () nil
   (drawable drawable) (gc gc) 
-  (font pango:font)
   (x int) (y int)
   (layout pango:layout)
   (foreground (or null color))
   (background (or null color)))
 
-(defun draw-layout (drawable gc font x y layout &optional foreground background)
+(defun draw-layout (drawable gc x y layout &optional foreground background)
   (if (or foreground background)
-      (%draw-layout-with-colors drawable gc font x y layout foreground background)
-    (%draw-layout drawable gc font x y layout)))
+      (%draw-layout-with-colors drawable gc x y layout foreground background)
+    (%draw-layout drawable gc x y layout)))
 
 (defbinding draw-drawable 
     (drawable gc src src-x src-y dest-x dest-y &optional width height) nil
@@ -1049,7 +1049,7 @@
 
 ;;; Key values
 
-(defbinding keyval-name () string
+(defbinding keyval-name () (static string)
   (keyval unsigned-int))
 
 (defbinding %keyval-from-name () unsigned-int
@@ -1122,25 +1122,26 @@
 #+sb-thread
 (progn
   (defvar *global-lock* nil)
+  (defvar *recursion-count* 0)
 
   (defun %global-lock-p ()
-    (eq (car (sb-thread:mutex-value *global-lock*)) sb-thread:*current-thread*))
+    (eq (sb-thread:mutex-value *global-lock*) sb-thread:*current-thread*))
 
   (defun threads-enter ()
     (when *global-lock*
       (if (%global-lock-p)
-	  (incf (cdr (sb-thread:mutex-value *global-lock*)))
-	(sb-thread:get-mutex *global-lock* (cons sb-thread:*current-thread* 0)))))
+	  (incf *recursion-count*)
+        (sb-thread:get-mutex *global-lock*))))
     
   (defun threads-leave (&optional flush-p)
     (when *global-lock*
       (assert (%global-lock-p))
       (cond
-       ((zerop (cdr (sb-thread:mutex-value *global-lock*)))
+       ((zerop *recursion-count*)
 	(when flush-p
 	  (flush))
 	(sb-thread:release-mutex *global-lock*))
-       (t (decf (cdr (sb-thread:mutex-value *global-lock*)))))))
+       (t (decf *recursion-count*)))))
 
   (define-callback %enter-fn nil ()
     (threads-enter))
@@ -1148,7 +1149,7 @@
   (define-callback %leave-fn nil ()
     (threads-leave))
   
-  (defbinding %threads-set-lock-functions (&optional) nil
+  (defbinding %threads-set-lock-functions (nil) nil
     (%enter-fn callback)
     (%leave-fn callback))