X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/2d96a1ee5a0315199abed9d6dc127ea2244a375d..0e932da14038fac734e85246659f2a27853817b2:/gdk/gdk.lisp?ds=sidebyside diff --git a/gdk/gdk.lisp b/gdk/gdk.lisp index 111723e..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.47 2007-11-14 12:52:32 espen Exp $ +;; $Id: gdk.lisp,v 1.50 2008-04-21 16:21:07 espen Exp $ (in-package "GDK") @@ -44,7 +44,7 @@ (defmethod print-object ((display display) stream) (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 display-close (&optional (display (display-get-default))) nil (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 @@ (defun ensure-display (display &optional existing-only-p) ;;; 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 region-xor (source1 source2) nil (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 list-visuals () (glist visual)) (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 @@ (defbinding window-get-origin () nil ; this may not work as (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) @@ -1120,25 +1122,26 @@ (defbinding (cairo-surface-get-window "clg_gdk_cairo_surface_get_window") () w #+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)) @@ -1146,7 +1149,7 @@ (define-callback %enter-fn nil () (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))