From 1b937a99686feeb91f88b37e46703b168395a3e0 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Tue, 14 Aug 2012 14:54:30 -0700 Subject: [PATCH] gtk: Require #f or #t from event and draw callbacks. Not even sure what a gboolean from the draw signal means, but requiring a bool anyway (else whatnot is coerced into gboolean?, TRUE?). Updated doc to mention this, and got all #ts and #fs under @code. --- doc/gtk/gtk.texinfo | 112 +++++++++++++++++++++++++++-------------- src/gtk/fix-layout.scm | 84 +++++++++++++++---------------- src/gtk/gtk-ev.scm | 11 ++-- src/gtk/gtk-widget.scm | 20 +++++++- 4 files changed, 138 insertions(+), 89 deletions(-) diff --git a/doc/gtk/gtk.texinfo b/doc/gtk/gtk.texinfo index 4e08a120c..1cc206037 100644 --- a/doc/gtk/gtk.texinfo +++ b/doc/gtk/gtk.texinfo @@ -232,7 +232,10 @@ Callbacks can be "connected" to gobjects --- one callback per signal name. The procedures run without-interrupts (or at least without-preemption, or perhaps just without-toolkit). Connecting a second callback disconnects the -first. All connected callbacks are ``pinned'' by the +first. + +@anchor{pinned-objects} +All connected callbacks are ``pinned'' by the @code{registered-callbacks} vector; they cannot be GCed until they are explicitly de-registered. The callback @emph{and} its closure are pinned. If the closure references the instance, the instance is @@ -252,7 +255,7 @@ the object has not yet been allocated, or if it is no longer alive. @end deffn @deffn Procedure gobject-live? gobject -#t while @var{gobject} is alive, #f after it has been killed. +@code{#t} while @var{gobject} is alive, @code{#f} after it has been killed. @end deffn @anchor{gobject-unref!} @@ -274,7 +277,7 @@ trampoline, as in this example: @end example Note that @var{delete-callback} should reference @var{window} via -parameter @emph{only} (per discussion above). +parameter @emph{only}. See @bref{pinned-objects}. @end deffn @deffn Procedure g-signal-disconnect gobject name @@ -671,7 +674,7 @@ Initializes @var{loader} and starts a new thread loading from @end deffn @deffn Procedure pixbuf-loader-size-hook loader -#f or the procedure that will be applied to the pixbuf size (two +@code{#f} or the procedure that will be applied to the pixbuf size (two integers, width and height). @end deffn @@ -683,7 +686,7 @@ immediately. @end deffn @deffn Procedure pixbuf-loader-pixbuf-hook loader -#f or the procedure that will be applied to the pixbuf as soon as it +@code{#f} or the procedure that will be applied to the pixbuf as soon as it is allocated. @end deffn @@ -695,7 +698,7 @@ immediately. @end deffn @deffn Procedure pixbuf-loader-update-hook loader -#f or the procedure that will be applied to areas of the pixbuf +@code{#f} or the procedure that will be applied to areas of the pixbuf recently updated. @end deffn @@ -708,7 +711,7 @@ is set, it will never be called. @end deffn @deffn Procedure pixbuf-loader-close-hook loader -#f or the thunk that will be invoked when loading is complete. +@code{#f} or the thunk that will be invoked when loading is complete. @end deffn @deffn Procedure set-pixbuf-loader-close-hook! loader thunk @@ -718,11 +721,11 @@ immediately. @end deffn @deffn Procedure pixbuf-loader-pixbuf loader -#f or the pixbuf that is loading (or was loaded). +@code{#f} or the pixbuf that is loading (or was loaded). @end deffn @deffn Procedure pixbuf-loader-error-message loader -#f or a string describing any error encountered during the loading. +@code{#f} or a string describing any error encountered during the loading. @end deffn @node Pango Layout, Cairo Context, Pixbuf Loader, API Reference @@ -924,7 +927,7 @@ Type guarantor. @end deffn @deffn Procedure gtk-widget-destroyed? widget -#f if @var{widget} has not been destroyed. +@code{#f} if @var{widget} has not been destroyed. @end deffn @deffn Procedure gtk-widget-destroy widget @@ -932,7 +935,7 @@ Destroys @var{widget}. @end deffn @deffn {Generic Procedure} gtk-widget-parent widget -The parent gtk-container, or #f. +The parent gtk-container, or @code{#f}. @end deffn @subsection Gtk Widget Callbacks @@ -959,22 +962,29 @@ closure, else it cannot be GCed. @deffn Procedure set-gtk-widget-draw-callback! widget callback Arranges for @var{callback} to be applied to @var{widget} and a cairo context clipped to the area to be re-drawn. +@var{Callback} should return @code{#t} or @code{#f} to indicate +whether the @code{"draw"} signal has been handled(?), else a warning +is issued. @end deffn @deffn Procedure set-gtk-widget-event-callback! widget callback Arrange for @var{callback} to be applied to @var{widget} and an alien -GdkEvent whenever the widget receives an event. Do @emph{not} capture -@var{widget} in @var{callback}'s closure, else it cannot be GCed. +GdkEvent whenever the widget receives an @code{"event"} signal. +@var{Callback} should return @code{#t} to stop emission of more +specific signals like @code{"focus-in-event"} and @code{"focus"}. It +must return either @code{#t} or @code{#f} else a warning is issued. +Do @emph{not} capture @var{widget} in @var{callback}'s closure, else +it cannot be GCed. @end deffn @subsection Gtk Widget Operators @deffn Procedure gtk-widget-realized? widget -#t if @var{widget} has been realized. +@code{#t} if @var{widget} has been realized. @end deffn @deffn Procedure gtk-widget-drawable? widget -#t if @var{widget} can be drawn, i.e. it is mapped and visible. +@code{#t} if @var{widget} can be drawn, i.e. it is mapped and visible. @end deffn @deffn Procedure gtk-widget-grab-focus widget @@ -986,12 +996,12 @@ the widget will likely fail and cause critical warnings. @end deffn @deffn Procedure gtk-widget-has-focus? widget -#t if @var{widget} has the keyboard. +@code{#t} if @var{widget} has the keyboard. @end deffn @anchor{gtk-widget-is-composited?} @deffn Procedure gtk-widget-is-composited? widget -#t if @var{widget} has an alpha channel. +@code{#t} if @var{widget} has an alpha channel. @end deffn @deffn Procedure gtk-widget-show widget @@ -1218,7 +1228,7 @@ The symbol @code{toplevel}, unless @var{window} is a popup. See @anchor{gtk-window-set-geometry-hints} @deffn Procedure gtk-window-set-geometry-hints window widget . hints -Sets @var{window}'s geometry hints. @var{Widget} can be #f or any +Sets @var{window}'s geometry hints. @var{Widget} can be @code{#f} or any widget that is ``showing'' in @var{window} (not just @var{window}'s immediate child). When specified, the geometry hints are applied to @var{widget}'s size, sizing @var{window} to account for decorations, @@ -1281,8 +1291,8 @@ Applies @var{receiver} to @var{window}'s default width and height. @end deffn @deffn Procedure gtk-window-parse-geometry window string -Returns #f if @var{string} is not a standard X geometry string. -Otherwise returns #t and sets @var{window}'s user-requested size +Returns @code{#f} if @var{string} is not a standard X geometry string. +Otherwise returns @code{#t} and sets @var{window}'s user-requested size and/or position. An X geometry string is something like @code{"-0+0"}, meaning ``upper right hand corner''. The X manpage contains the full details. Note that for this procedure to work @@ -1396,7 +1406,7 @@ A new gtk check button. @end deffn @deffn Procedure gtk-check-button-get-active button -#t if @var{button} is ``on'', #f if it is ``off''. +@code{#t} if @var{button} is ``on'', @code{#f} if it is ``off''. @end deffn @deffn Procedure gtk-check-button-set-active button active? @@ -1538,6 +1548,10 @@ in @code{GTK_SIZE_REQUEST_CONSTANT_SIZE} mode. A direct subclass of gtk-widget representing a reference to a ScmWidget. @end deffn +@deffn Procedure guarantee-scm-widget object operator +Type guarantor. +@end deffn + @deffn Procedure set-scm-widget-set-scroll-adjustments-callback! widget callback Arranges for @var{callback} to be applied to @var{widget} and the horizontal and vertical GtkAdjustments (aliens). These need to be @@ -1564,6 +1578,12 @@ This simple Scheme widget manages the GdkWindow on which more specialized methods will draw. It allocates, moves and resizes the GdkWindow, and dispatches events received on it. +@anchor{event-handler-note} Note that the event handlers are run by +the generic @code{"event"} signal, and can return @code{#t} to stop +emission of more specific signals like @code{"focus-in-event"} and +@code{"focus"}. They must return either @code{#t} or @code{#f} else a +warning is issued. + @deffn Class A direct subclass of scm-widget. A ScmWidget toolkit object. @end deffn @@ -1664,31 +1684,43 @@ This procedure is called when @var{widget} is being realized. @deffn Procedure set-fix-widget-map-handler! widget handler Arranges to apply @var{handler} to @var{widget} when it is mapped. +@var{handler} must return @code{#t} or @code{#f}. +See @bref{event-handler-note}. @end deffn @deffn Procedure set-fix-widget-unmap-handler! widget handler Arranges to apply @var{handler} to @var{widget} when it is unmapped. +@var{handler} must return @code{#t} or @code{#f}. +See @bref{event-handler-note}. @end deffn @deffn Procedure set-fix-widget-enter-notify-handler! widget handler Arranges to apply @var{handler} to @var{widget} when the pointer enters. +@var{handler} must return @code{#t} or @code{#f}. +See @bref{event-handler-note}. @end deffn @deffn Procedure set-fix-widget-leave-notify-handler! widget handler Arranges to apply @var{handler} to @var{widget} when the pointer leaves. +@var{handler} must return @code{#t} or @code{#f}. +See @bref{event-handler-note}. @end deffn @deffn Procedure set-fix-widget-focus-change-handler! widget handler Arranges to apply @var{handler} to @var{widget} and a boolean value -when it receives a focus change event. The boolean is #t if +when it receives a focus change event. The boolean is @code{#t} if @var{widget} is now in focus. +@var{handler} must return @code{#t} or @code{#f}. +See @bref{event-handler-note}. @end deffn @deffn Procedure set-fix-widget-visibility-notify-handler! widget handler Arranges to apply @var{handler} to @var{widget} and a symbol: one of @code{visible}, @code{partially-obscured} or @code{obscured}. +@var{handler} must return @code{#t} or @code{#f}. +See @bref{event-handler-note}. @end deffn @deffn Procedure set-fix-widget-key-press-handler! widget handler @@ -1697,6 +1729,8 @@ press event. @var{Handler} is applied to @var{widget}, a key name, and a bitmap of char-bits. See @bref{gdk-keyval->name} and @bref{gdk-key-state->char-bits} for the range of the last two arguments. +@var{handler} must return @code{#t} or @code{#f}. +See @bref{event-handler-note}. @end deffn @anchor{set-fix-widget-motion-handler!} @@ -1723,6 +1757,8 @@ symbols @code{hyper}, @code{meta} and @code{release}. +@var{handler} must return @code{#t} or @code{#f}. +See @bref{event-handler-note}. @end deffn @deffn Procedure set-fix-widget-button-handler! widget type handler @@ -1733,6 +1769,8 @@ button event of the specified @var{type} --- one of the symbols @var{type}, the button number (a fixnum), the modifiers, and the coordinates of the pointer. See @bref{set-fix-widget-motion-handler!}. +@var{handler} must return @code{#t} or @code{#f}. +See @bref{event-handler-note}. @end deffn @section Fix Resizer @@ -1811,7 +1849,7 @@ A new fix-layout with natural size @var{width} x @var{height}. @end deffn @deffn {Generic Procedure} fix-layout-drawing layout -The fix-drawing displayed in @var{layout}, or #f. +The fix-drawing displayed in @var{layout}, or @code{#f}. @end deffn @anchor{set-fix-layout-drawing!} @@ -1886,7 +1924,7 @@ bounding boxes include the point (@var{x}, @var{y}). @deffn Procedure fix-drawing-add-ink! drawing ink #!optional where Adds @var{ink} to the top of the display list for @var{drawing}. If -@var{where} is specified, it should be the symbol @var{top} (or #f), +@var{where} is specified, it should be the symbol @var{top} (or @code{#f}), the symbol @var{bottom}, or an ink already in the display list. When @var{where} is an ink, @var{ink} is spliced in just under (before) it. @end deffn @@ -1905,16 +1943,16 @@ Type predicate. @end deffn @deffn {Generic Procedure} fix-ink-drawing ink -@var{Ink}'s fix-drawing, or #f. +@var{Ink}'s fix-drawing, or @code{#f}. @end deffn @deffn Procedure fix-ink-widgets ink -The widgets in which @var{ink} should be drawn, #t if it is drawn in +The widgets in which @var{ink} should be drawn, @code{#t} if it is drawn in all views. @end deffn @deffn Procedure set-fix-ink-widgets! ink widgets -Draw @var{ink} only in the @var{widgets}. If @var{widgets} is #t, +Draw @var{ink} only in the @var{widgets}. If @var{widgets} is @code{#t}, @var{ink} will appear in all views of the drawing. @end deffn @@ -2052,7 +2090,7 @@ color last provided to @bref{set-rectangle-ink-fill-color!}. @anchor{set-rectangle-ink-fill-color!} @deffn Procedure set-rectangle-ink-fill-color! rectangle color -Sets @var{rectangle}'s fill color. If @var{color} is #f, +Sets @var{rectangle}'s fill color. If @var{color} is @code{#f}, @var{rectangle} is outlined, not filled. @end deffn @@ -2124,7 +2162,7 @@ provided to @bref{set-arc-ink-fill-color!}. @anchor{set-arc-ink-fill-color!} @deffn Procedure set-arc-ink-fill-color! arc color -Sets @var{arc}'s fill color. If @var{color} is #f, @var{arc} is not +Sets @var{arc}'s fill color. If @var{color} is @code{#f}, @var{arc} is not filled. @end deffn @@ -2149,13 +2187,13 @@ Sets the position of the upper left corner of @var{text}, a text-ink. @deffn Procedure text-ink-xy-to-index text x y If (@var{x}, @var{y}) is in @var{text}'s extent, return the index of -the character at that point, else #f. +the character at that point, else @code{#f}. @end deffn @deffn Procedure with-text-ink-grapheme-rect text index receiver Applies @var{receiver} to the position and size (four fixnums) of the @var{index}th character in @var{text}'s text. If @var{text} has no -text, this procedure just returns #f; it does not apply +text, this procedure just returns @code{#f}; it does not apply @var{receiver}. It normally returns @var{receiver}'s return value. @end deffn @@ -2198,7 +2236,7 @@ displaying @var{ink}. See @bref{set-fix-layout-drawing!}. @end deffn @deffn Procedure simple-text-ink-font text -#f or a PangoFontDescription alien. +@code{#f} or a PangoFontDescription alien. @end deffn @deffn Procedure set-simple-text-ink-font! text font @@ -2258,7 +2296,7 @@ procedure does nothing. @deffn Procedure gdk-window-process-updates window children-too? Force expose events to be delivered immediately and synchronously to @var{window}. This is occasionally useful, e.g. to produce nicer -scrolling behavior. @var{Children-too?} should be #f to avoid +scrolling behavior. @var{Children-too?} should be @code{#f} to avoid sending expose events to child windows. @end deffn @@ -2288,19 +2326,19 @@ A convenient procedure to determine whether the toolkit is dead. @end deffn @deffn Procedure gtk-time-slice-window? -#t if the time slice window is open, else #f. +@code{#t} if the time slice window is open, else @code{#f}. @end deffn @deffn Procedure gtk-time-slice-window! open? -If @var{open?} is #f, the time slice window is closed, else it is opened. +If @var{open?} is @code{#f}, the time slice window is closed, else it is opened. @end deffn @deffn Procedure gtk-select-trace? -#t if Scheme's GSource is being traced, else #f. +@code{#t} if Scheme's GSource is being traced, else @code{#f}. @end deffn @deffn Procedure gtk-select-trace! trace? -If @var{trace?} is #t, turns on tracing of Scheme's GSource. +If @var{trace?} is @code{#t}, turns on tracing of Scheme's GSource. @end deffn @node Installation, Implementation Notes, API Reference, Top diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm index 022d2d124..17717b5db 100644 --- a/src/gtk/fix-layout.scm +++ b/src/gtk/fix-layout.scm @@ -156,9 +156,8 @@ USA. (%trace2 " "(C-enum "GdkEventType" type)"\n") (let ((handler (vector-ref (fix-widget-event-handlers widget) type))) (if handler - (if (handler widget GdkEvent) 1 0) - ;; Unhandled - 0)))) + (handler widget GdkEvent) + #f)))) (define (set-fix-widget-map-handler! widget handler) (guarantee-fix-widget widget 'set-fix-widget-map-handler!) @@ -404,14 +403,21 @@ USA. (fix:clip-region cr (lambda (x y w h) (if drawing - (begin + (let ((area (make-fix-rect (fix:+ x offx) (fix:+ y offy) w h))) (%trace2 ";draw area "x","y" "w"x"h" of "layout".\n") - (drawing-expose drawing layout window cr - (make-fix-rect (fix:+ x offx) (fix:+ y offy) - w h))) + ;; AREA is in drawing coords. + (for-each + (lambda (ink) + (if (fix-ink-in? ink layout area) + (begin + (C-call "cairo_save" cr) + (fix-ink-draw-callback ink layout + window cr area) + (C-call "cairo_restore" cr)))) + (fix-drawing-display-list drawing))) (%trace2 ";draw area "x","y" "w"x"h - " of "layout" (no drawing!).\n")))) - 1))) ;; handled + " of "layout" (no drawing!).\n")) + #t))))) (define (set-fix-layout-scroll-size! widget width height) ;; Tells WIDGET to adjust its scrollable extent. Notifies any @@ -564,9 +570,7 @@ USA. (connect-adjustment (fix-layout-vadjustment widget) vGtkAdjustment widget set-fix-layout-vadjustment!) (if (fix-widget-realized? widget) - (adjust-adjustments widget)) - 0 ;; What does this mean? - ) + (adjust-adjustments widget))) (define (connect-adjustment old-adjustment new-alien widget setter) ;; Disconnects OLD-ADJUSTMENT (if any) and applies SETTER to WIDGET @@ -707,44 +711,45 @@ USA. (C-call "gtk_cairo_transform_to_window" cr (gobject-alien resizer) (fix-widget-window resizer)) (C-call "gtk_render_handle" style cr - (->flonum (fix-rect-x geom)) - (->flonum (fix-rect-y geom)) + 0. 0. (->flonum (fix-rect-width geom)) (->flonum (fix-rect-height geom))) - 1)) ;; handled + #t)) (define (resizer-enter-handler resizer) (%trace ";resizer-enter-handler\n") (if (and (fix-resizer-before resizer) (fix-resizer-after resizer)) (C-call "gtk_widget_set_state_flags" - (gobject-alien resizer) (C-enum "GTK_STATE_FLAG_PRELIGHT") 0))) + (gobject-alien resizer) (C-enum "GTK_STATE_FLAG_PRELIGHT") 0)) + #t) (define (resizer-leave-handler resizer) (%trace ";resizer-leave-handler\n") (if (not (fix-resizer-dragging? resizer)) (C-call "gtk_widget_unset_state_flags" - (gobject-alien resizer) (C-enum "GTK_STATE_FLAG_PRELIGHT")))) + (gobject-alien resizer) (C-enum "GTK_STATE_FLAG_PRELIGHT"))) + #t) (define (resizer-press-handler resizer type button modifiers x y) -;;; (declare (ignore type)) ;; 'press (%trace ";resizer-press-handler "type" "button" "modifiers" "x","y"\n") (let ((before (fix-resizer-before resizer)) (after (fix-resizer-after resizer))) - (if (and before after (eq? button 1)) - (begin - (%trace "; drag start\n") - (set-fix-resizer-dragging?! resizer #t) - (C-call "gtk_grab_add" (gobject-alien resizer)))))) + (and before after (eq? button 1) + (begin + (%trace "; drag start\n") + (set-fix-resizer-dragging?! resizer #t) + (C-call "gtk_grab_add" (gobject-alien resizer)) + #t)))) (define (resizer-release-handler resizer type button modifiers x y) -;;; (declare (ignore type)) ;; 'release (%trace ";resizer-release-handler "type" "button" "modifiers" "x","y"\n") - (if (fix-resizer-dragging? resizer) - (begin - (%trace "; drag end!\n") - (set-fix-resizer-dragging?! resizer #f) - (C-call "gtk_grab_remove" (gobject-alien resizer))))) + (and (fix-resizer-dragging? resizer) + (begin + (%trace "; drag end!\n") + (set-fix-resizer-dragging?! resizer #f) + (C-call "gtk_grab_remove" (gobject-alien resizer)) + #t))) (define (resizer-motion-handler resizer modifiers x y) (%trace ";resizer-motion-handler "resizer" "modifiers" "x" "y"\n") @@ -771,7 +776,8 @@ USA. (C-call "gtk_widget_queue_resize_no_redraw" (gobject-alien before)) (C-call "gtk_widget_queue_resize_no_redraw" - (gobject-alien after)))))) + (gobject-alien after)))) + #t)) (if (fix-resizer-stack-vertical? resizer) @@ -817,7 +823,9 @@ USA. (begin (%trace "; drag dropped!\n") (C-call "gtk_grab_remove" (gobject-alien resizer)) - (set-fix-resizer-dragging?! resizer #f))))) + (set-fix-resizer-dragging?! resizer #f) + #f)) + #f)) (define-class ( (constructor () no-init)) () @@ -862,18 +870,6 @@ USA. (and (fix-ink-in-widget? ink widget) (point-in-fix-rect? x y (fix-ink-extent ink)))))) -(define (drawing-expose drawing widget window cr area) - ;; AREA is in drawing coords. - (if (fix-rect-nominal? area) - (for-each - (lambda (ink) - (if (fix-ink-in? ink widget area) - (begin - (C-call "cairo_save" cr) - (fix-ink-draw-callback ink widget window cr area) - (C-call "cairo_restore" cr)))) - (fix-drawing-display-list drawing)))) - (define (fix-ink-in? ink widget area) (declare (integrate-operator fix-ink-in?)) (and (fix-ink-in-widget? ink widget) @@ -887,7 +883,7 @@ USA. (memq widget widgets)))) (define-generic fix-ink-draw-callback (ink widget window cr exposed-area) - ;; Due to the checks in drawing-expose, methods of this generic can + ;; Due to the checks in layout-draw-callback, methods of this generic can ;; assume expose-area and the ink's extent are intersecting, and INK ;; is visible in the WIDGET. Methods may also assume the widget is ;; realized and its window's cairo's clipping is already set. The diff --git a/src/gtk/gtk-ev.scm b/src/gtk/gtk-ev.scm index 7acf50a99..bc7e027a9 100644 --- a/src/gtk/gtk-ev.scm +++ b/src/gtk/gtk-ev.scm @@ -194,15 +194,14 @@ USA. (if (= type (C-enum "GDK_MOTION_NOTIFY")) (C-call "gdk_window_get_pointer" #f (C-> GdkEvent "GdkEventMotion window") 0 0 0)) - 0 ;;FALSE -- continue handling. + #f ;; continue handling. )) (define (draw-callback widget cr) - (%trace "; Draw "widget"\n") - (paint-event-window widget cr) - (paint-window widget cr) - 1 ;;TRUE -- handled. - ) + (%trace "; Draw "widget"\n") + (paint-event-window widget cr) + (paint-window widget cr) + #t) (define (paint-window widget cr) (%trace2 ";(paint-window "widget" "cr")\n") diff --git a/src/gtk/gtk-widget.scm b/src/gtk/gtk-widget.scm index e6603c402..dc43c6dc6 100644 --- a/src/gtk/gtk-widget.scm +++ b/src/gtk/gtk-widget.scm @@ -238,12 +238,28 @@ USA. (define (set-gtk-widget-draw-callback! widget callback) (guarantee-gtk-widget widget 'set-gtk-widget-draw-callback!) (guarantee-procedure-of-arity callback 2 'set-gtk-widget-draw-callback!) - (g-signal-connect widget (c-callback "draw") callback)) + (g-signal-connect widget (c-callback "draw") (make-draw-callback callback))) + +(define (make-draw-callback callback) + (named-lambda (draw-callback widget cr) + (let ((handled? (callback widget cr))) + (cond ((eq? handled? #t) 1) + ((eq? handled? #f) 0) + (else (warn "Draw callback not boolean:" callback) + 0))))) (define (set-gtk-widget-event-callback! widget callback) (guarantee-gtk-widget widget 'set-gtk-widget-event-callback!) (guarantee-procedure-of-arity callback 2 'set-gtk-widget-event-callback!) - (g-signal-connect widget (C-callback "event") callback)) + (g-signal-connect widget (C-callback "event") (make-event-callback callback))) + +(define (make-event-callback callback) + (named-lambda (event-callback widget event) + (let ((handled? (callback widget event))) + (cond ((eq? handled? #t) 1) + ((eq? handled? #f) 0) + (else (warn "Event callback not boolean:" callback) + 0))))) ;;; GtkWidget Font -- 2.25.1