From: espen <espen>
Date: Sun, 26 Dec 2004 11:51:21 +0000 (+0000)
Subject: Bindings for window and window-group completed
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/commitdiff_plain/4d16221f279ea4790831c469da1171d2a629d976?hp=3a63ef2a6c503a66bf1559fc60f5e3e07d0838be

Bindings for window and window-group completed
---

diff --git a/gtk/alien/glue.c b/gtk/alien/glue.c
index f26ec68..5f41986 100644
--- a/gtk/alien/glue.c
+++ b/gtk/alien/glue.c
@@ -16,7 +16,7 @@
  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  */
 
-/* $Id: glue.c,v 1.4 2004-12-20 20:00:46 espen Exp $ */
+/* $Id: glue.c,v 1.5 2004-12-26 11:51:21 espen Exp $ */
 
 
 #include <gtk/gtk.h>
@@ -98,6 +98,13 @@ gtk_window_get_default (GtkWindow *window)
   return window->default_widget;
 }
 
+GtkWindowGroup*
+gtk_window_get_group (GtkWindow *window)
+{
+  return window->group;
+}
+
+
 
 /* Layout */
 
diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp
index 9d4a734..b76bff5 100644
--- a/gtk/gtk.lisp
+++ b/gtk/gtk.lisp
@@ -15,7 +15,7 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
-;; $Id: gtk.lisp,v 1.26 2004-12-21 00:15:19 espen Exp $
+;; $Id: gtk.lisp,v 1.27 2004-12-26 11:51:21 espen Exp $
 
 
 (in-package "GTK")
@@ -773,7 +773,41 @@ (defbinding window-set-default-size (window width height) int
   ((or width -1) int)
   ((or height -1) int))
 
-;(defbinding window-set-geometry-hints)
+(defbinding %window-set-geometry-hints () nil
+  (window window)
+  (geometry gdk:geometry)
+  (geometry-mask gdk:window-hints))
+
+(defun window-set-geometry-hints (window &key min-width min-height
+                                  max-width max-height base-width base-height
+				  width-inc height-inc min-aspect max-aspect
+				  (gravity nil gravity-p) min-size max-size)
+  (let ((geometry (make-instance 'gdk:geometry 
+		   :min-width (or min-width -1)
+		   :min-height (or min-height -1)
+		   :max-width (or max-width -1)
+		   :max-height (or max-height -1)
+		   :base-width (or base-width 0)
+		   :base-height (or base-height 0)
+		   :width-inc (or width-inc 0)
+		   :height-inc (or height-inc 0)
+		   :min-aspect (or min-aspect 0)
+		   :max-aspect (or max-aspect 0)
+		   :gravity gravity))
+	(mask ()))
+    (when (or min-size min-width min-height)
+      (push :min-size mask))
+    (when (or max-size max-width max-height)
+      (push :max-size mask))
+    (when (or base-width base-height)
+      (push :base-size mask))
+    (when (or width-inc height-inc)
+      (push :resize-inc mask))
+    (when (or min-aspect max-aspect)
+      (push :aspect mask))
+    (when gravity-p
+      (push :win-gravity mask))
+    (%window-set-geometry-hints window geometry mask)))
 
 (defbinding window-list-toplevels () (glist (copy-of window))
   "Returns a list of all existing toplevel windows.")
@@ -793,6 +827,14 @@ (defbinding window-mnemonic-activate (window key modifier) nil
   ((gdk:keyval-from-name key) unsigned-int)
   (modifier gdk:modifier-type))
 
+(defbinding window-activate-key () boolean
+  (window window)
+  (event gdk:key-event))
+
+(defbinding window-propagate-key-event () boolean
+  (window window)
+  (event gdk:key-event))
+
 (defbinding window-present () nil
   (window window))
 
@@ -814,6 +856,20 @@ (defbinding window-maximize () nil
 (defbinding window-unmaximize () nil
   (window window))
 
+(defbinding window-fullscreen () nil
+  (window window))
+
+(defbinding window-unfullscreen () nil
+  (window window))
+
+(defbinding window-set-keep-above () nil
+  (window window)
+  (setting boolean))
+
+(defbinding window-set-keep-below () nil
+  (window window)
+  (setting boolean))
+
 (defbinding window-begin-resize-drag () nil
   (window window)
   (edge gdk:window-edge)
@@ -832,9 +888,6 @@ (defbinding window-set-frame-dimensions () nil
   (window window)
   (left int) (top int) (rigth int) (bottom int))
 
-(defbinding (window-default-icons "gtk_window_get_default_icon_list")
-    () (glist gdk:pixbuf))
-
 (defbinding %window-get-default-size () nil
   (window window)
   (width int :out)
@@ -851,12 +904,6 @@ (defbinding window-get-frame-dimensions () nil
 (defbinding %window-get-icon-list () (glist gdk:pixbuf)
   (window window))
 
-(defmethod window-icon ((window window))
-  (let ((icon-list (%window-get-icon-list window)))
-    (if (endp (rest icon-list))
-	(first icon-list)
-      icon-list)))
-
 (defbinding window-get-position () nil
   (window window)
   (root-x int :out)
@@ -884,19 +931,86 @@ (defbinding window-resize () nil
   (width int)
   (heigth int))
 
-(defbinding %window-set-icon-list () nil
+(defbinding (window-default-icon-list "gtk_window_get_default_icon_list")
+    () (glist gdk:pixbuf))
+
+(defun window-default-icon ()
+  (first (window-default-icon-list)))
+
+(defbinding %window-set-default-icon-list () nil
+  (icons (glist gdk:pixbuf)))
+
+(defun (setf window-default-icon-list) (icons)
+  (%window-set-default-icon-list icons)
+  icons)
+
+(defbinding %window-set-default-icon () nil
+  (icons (glist gdk:pixbuf)))
+
+(defmethod (setf window-default-icon) ((icon gdk:pixbuf))
+  (%window-set-default-icon icon)
+  icon)
+
+(defmethod (setf window-group) ((group window-group) (window window))
+  (window-group-add-window group window)
+  group)
+
+(defbinding %window-set-default-icon-from-file () boolean
+  (filename pathname)
+  (nil null))
+
+(defmethod (setf window-default-icon) ((icon-file pathname))
+  (%window-set-default-icon-from-file icon-file)
+  icon-file)
+
+(defbinding %window-set-icon-from-file () boolean
+  (window window)
+  (filename pathname)
+  (nil null))
+
+(defmethod (setf window-icon) ((icon-file pathname) (window window))
+  (%window-set-icon-from-file window icon-file)
+  icon-file)
+
+(defbinding window-set-auto-startup-notification () nil
+  (setting boolean))
+
+(defbinding decorated-window-init () nil
+  (window window))
+
+(defbinding decorated-window-calculate-frame-size () nil
+  (window window))
+
+(defbinding decorated-window-set-title () nil
   (window window)
-  (icon-list (glist gdk:pixbuf)))
+  (title string))
 
-(defmethod (setf window-icon) (icon (window window))
-  (%window-set-icon-list window (mklist icon)))
+(defbinding decorated-window-move-resize-window () nil
+  (window window)
+  (x int)
+  (y int)
+  (width int)
+  (heigth int))
 
 
+;;; Window group
 
+(defmethod initialize-instance ((window-group window-group) &rest initargs 
+				&key window windows)
+  (declare (ignore window windows))
+  (prog1
+      (call-next-method)
+    (initial-add window-group #'window-group-add-window 
+     initargs :window :windows)))
 
-;;; File chooser
 
+(defbinding window-group-add-window () nil
+  (window-group window-group)
+  (window window))
 
+(defbinding window-group-remove-window () nil
+  (window-group window-group)
+  (window window))
 
 
 ;;; Scrolled window
diff --git a/gtk/gtktypes.lisp b/gtk/gtktypes.lisp
index fdb9faf..a31f9fa 100644
--- a/gtk/gtktypes.lisp
+++ b/gtk/gtktypes.lisp
@@ -15,7 +15,7 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
-;; $Id: gtktypes.lisp,v 1.25 2004-12-20 22:43:26 espen Exp $
+;; $Id: gtktypes.lisp,v 1.26 2004-12-26 11:51:21 espen Exp $
 
 
 (in-package "GTK")
@@ -146,7 +146,6 @@ (define-types-by-introspection "Gtk"
     (window
      :allocation :virtual
      :getter "gtk_widget_get_window"
-     :unbound nil
      :reader widget-window
      :type gdk:window)
     (state
@@ -160,14 +159,12 @@ (define-types-by-introspection "Gtk"
      :allocation :virtual
      :getter "gtk_widget_get_colormap"
      :setter "gtk_widget_set_colormap"
-     :unbound nil
      :initarg :colormap
      :accessor widget-colormap
      :type gdk:colormap)
     (visual
      :allocation :virtual
      :getter "gtk_widget_get_visual"
-     :unbound nil
      :reader widget-visual
      :type gdk:visual)
     (direction
@@ -187,7 +184,6 @@ (define-types-by-introspection "Gtk"
     (settings
      :allocation :virtual
      :getter "gtk_widget_get_settings"
-     :unbound nil
      :accessor widget-settings
      :type settings)
     (child-visible
@@ -247,14 +243,7 @@ (define-types-by-introspection "Gtk"
 
   ("GtkWindow"
    :slots
-   ((gravity
-     :allocation :virtual
-     :getter "gtk_window_get_gravity"
-     :setter "gtk_window_set_gravity"
-     :accessor window-gravity
-     :initarg :gravity
-     :type gdk:gravity)
-    (focus-widget
+   ((focus-widget
      :allocation :virtual
      :getter "gtk_window_get_focus"
      :setter "gtk_window_set_focus"
@@ -268,13 +257,6 @@     (default-widget
      :accessor window-default-widget
      :initarg :default-widget
      :type widget)
-    (decorated
-     :allocation :virtual
-     :getter "gtk_window_get_decorated"
-     :setter "gtk_window_set_decorated"
-     :accessor window-decorated-p
-     :initarg :decorated
-     :type boolean)
     (has-frame
      :allocation :virtual
      :getter "gtk_window_get_has_frame"
@@ -282,25 +264,13 @@     (default-widget
      :accessor window-has-frame-p
      :initarg :has-frame
      :type boolean)
-    (role
+    (icon-list
      :allocation :virtual
-     :getter "gtk_window_get_role"
-     :setter "gtk_window_set_role"
-     :accessor window-role
-     :initarg :role
-     :type string)
-    (type-hint
-     :allocation :virtual
-     :getter "gtk_window_get_type_hint"
-     :setter "gtk_window_set_type_hint"
-     :accessor window-type-hint
-     :initarg :type-hint
-     :type gdk:window-type-hint)
-    (icon
-     :allocation :virtual
-     :getter window-icon
-     :setter (setf window-icon)
-     :initarg :icon)
+     :getter "gtk_window_get_icon_list"
+     :setter "gtk_window_set_icon_list"
+     :accessor window-icon-list
+     :initarg :icon-list
+     :type (glist gdk:pixbuf))
     (mnemonic-modifier
      :allocation :virtual
      :getter "gtk_window_get_mnemonic_modifier"
@@ -314,8 +284,24 @@     (default-widget
      :setter "gtk_window_set_transient_for"
      :accessor window-transient-for
      :initarg :transient-for
-     :type window)))
+     :type window)
+    (group
+     :allocation :virtual
+     :getter "gtk_window_get_group"
+     :setter (setf window-group)
+     :reader window-group
+     :initarg :group
+     :type window-group)
+    (default-width :merge t :unbound -1)
+    (default-height :merge t :unbound -1)))
   
+  ("GtkWindowGroup"
+   :slots
+   ((grabs
+     :allocation :alien
+     :accessor window-group-grabs
+     :type (gslist window))))
+
   ("GtkTooltips"
    :slots
    ((enabled