From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Fri, 5 Apr 2013 17:12:47 +0000 (-0700)
Subject: gtk: Add gtk-window-set-type-hint.
X-Git-Tag: mit-scheme-pucked-9.2.12~528
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7504e771847baee63bb57b42c9520e9022d4c420;p=mit-scheme.git

gtk: Add gtk-window-set-type-hint.
---

diff --git a/src/gtk/Includes/gtkwindow.cdecl b/src/gtk/Includes/gtkwindow.cdecl
index 7738691ac..74a29dd43 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))
 	(opacity gdouble))
 
+(extern void
+	gtk_window_set_type_hint
+	(window (* GtkWindow))
+	(hint GdkWindowTypeHint))
+
 (extern gdouble
 	gtk_window_get_opacity
 	(window (* GtkWindow)))
diff --git a/src/gtk/gtk-widget.scm b/src/gtk/gtk-widget.scm
index bdb776285..fa0107e81 100644
--- a/src/gtk/gtk-widget.scm
+++ b/src/gtk/gtk-widget.scm
@@ -832,6 +832,23 @@ USA.
       (error:bad-range-argument opacity 'gtk-window-set-opacity))
   (C-call "gtk_window_set_opacity" (gobject-alien window) opacity))
 
+(define (gtk-window-set-type-hint window hint)
+  (guarantee-gtk-window window 'gtk-window-set-type-hint)
+  (let ((type-hint (->type-hint hint 'gtk-window-set-type-hint)))
+    (C-call "gtk_window_set_type_hint" (gobject-alien window) type-hint)))
+
+(define (->type-hint object operator)
+  (case object
+    ((NORMAL) (C-enum "GDK_WINDOW_TYPE_HINT_NORMAL"))
+    ((DIALOG) (C-enum "GDK_WINDOW_TYPE_HINT_DIALOG"))
+    ((MENU) (C-enum "GDK_WINDOW_TYPE_HINT_MENU"))
+    ((TOOLBAR) (C-enum "GDK_WINDOW_TYPE_HINT_TOOLBAR"))
+    ((SPLASHSCREEN) (C-enum "GDK_WINDOW_TYPE_HINT_SPLASHSCREEN"))
+    ((UTILITY) (C-enum "GDK_WINDOW_TYPE_HINT_UTILITY"))
+    ((DOCK) (C-enum "GDK_WINDOW_TYPE_HINT_DOCK"))
+    ((DESKTOP) (C-enum "GDK_WINDOW_TYPE_HINT_DESKTOP"))
+    (else (error:wrong-type-argument object "a GdkWindow type hint" operator))))
+
 (define (gtk-window-get-default-size window receiver)
   (guarantee-gtk-window window 'gtk-window-get-default-size)
   (let* ((*width (malloc (fix:* 2 (C-sizeof "gint")) 'gint))
diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index 402def643..07ffc45fe 100644
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -182,6 +182,7 @@ USA.
 	  gtk-window-set-geometry-hints
 	  gtk-window-set-title
 	  gtk-window-set-opacity
+	  gtk-window-set-type-hint
 	  gtk-window-set-default-size gtk-window-get-default-size
 	  gtk-window-parse-geometry
 	  gtk-window-resize