From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Sat, 30 Apr 2016 19:35:52 +0000 (-0700)
Subject: gtk: Add gtk-window-set-accept-focus.
X-Git-Tag: mit-scheme-pucked-9.2.12~328
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3750ecdbb55b8493aee904e8686373f2e8b6b246;p=mit-scheme.git

gtk: Add gtk-window-set-accept-focus.
---

diff --git a/src/gtk/Includes/gtkwindow.cdecl b/src/gtk/Includes/gtkwindow.cdecl
index 9c3b00cbf..795f530aa 100644
--- a/src/gtk/Includes/gtkwindow.cdecl
+++ b/src/gtk/Includes/gtkwindow.cdecl
@@ -25,6 +25,11 @@ gtk-2.0/gtk/gtkwindow.h |#
 	(window (* GtkWindow))
 	(hint GdkWindowTypeHint))
 
+(extern void
+	gtk_window_set_accept_focus
+	(window (* GtkWindow))
+	(setting gboolean))
+
 (extern void
 	gtk_window_set_geometry_hints
 	(window (* GtkWindow))
diff --git a/src/gtk/gtk-widget.scm b/src/gtk/gtk-widget.scm
index d9d8fefcc..0a6548bfd 100644
--- a/src/gtk/gtk-widget.scm
+++ b/src/gtk/gtk-widget.scm
@@ -848,6 +848,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
      (error:wrong-type-argument
       type "a symbol -- one of TOPLEVEL or POPUP" operator))))
 
+(define (gtk-window-set-accept-focus window accept?)
+  (guarantee-gtk-window window 'gtk-window-set-accept-focus)
+  (C-call "gtk_window_set_accept_focus"
+	  (gobject-alien window)
+	  (if (eq? accept? #f) 0 1)))
+
 (define (gtk-window-set-title window title)
   (guarantee-gtk-window window 'gtk-window-set-title)
   (guarantee-string title 'gtk-window-set-title)
diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index f465923ce..d33f15950 100644
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -107,6 +107,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 	  <gtk-window> gtk-window? guarantee-gtk-window
 	  gtk-window-new gtk-window-type
+	  gtk-window-set-accept-focus
 	  gtk-window-set-geometry-hints
 	  gtk-window-set-title
 	  gtk-window-set-type-hint