X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/050f6c9f2af72fa8a1114b02e823118ef258e08a..eba2d996724fcedbb6fc4b0e642d3a88b49bfb72:/gtk/gtk.lisp

diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp
index 80725a4..c70e830 100644
--- a/gtk/gtk.lisp
+++ b/gtk/gtk.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: gtk.lisp,v 1.73 2007-06-19 11:32:25 espen Exp $
+;; $Id: gtk.lisp,v 1.78 2007-07-10 08:45:06 espen Exp $
 
 
 (in-package "GTK")
@@ -74,7 +74,7 @@
 	(%init-async-event-handling display)
       #+sb-thread(%init-multi-threaded-event-handling display)
       #-sb-thread(error "Multi threading not supported on this platform")))
-  (gdk:find-display display))
+  (gdk:ensure-display display t))
 
 (defun clg-init-with-threading (&optional display)
   (clg-init display t))
@@ -88,12 +88,14 @@
       (sb-unix:fd-zero read-fds)
       (sb-unix:fd-set fd read-fds)
 
-      (unless (zerop (sb-unix:unix-fast-select 
-		      (1+ fd) (sb-alien:addr read-fds) nil nil 
-		      seconds microseconds))
-	(if (peek-char nil (car socket) nil)
-	    :input
-	  :eof)))))
+      (let ((num-fds-changed
+	     (sb-unix:unix-fast-select
+	      (1+ fd) (sb-alien:addr read-fds) nil nil 
+	      seconds microseconds)))
+	(unless (or (not num-fds-changed) (zerop num-fds-changed))
+	  (if (peek-char nil (car socket) nil)
+	      :input
+	    :eof))))))
 
 (defun %init-async-event-handling (display)
   (let ((style #?(or (featurep :cmu) (sbcl< 1 0 6)) :fd-handler
@@ -327,7 +329,7 @@
   (multiple-value-bind (key modifiers) (parse-accelerator accelerator)
     (%accel-groups-activate object key modifiers)))
 
-(defbinding accel-groups-from-object () (gslist accel-groups)
+(defbinding accel-groups-from-object () (gslist accel-group)
   (object gobject))
 
 (defbinding accelerator-valid-p (key &optional modifiers) boolean
@@ -519,6 +521,56 @@
   (right unsigned-int))
 
 
+;;; Assistant
+
+#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.10.0")
+(progn
+  (defbinding assistant-get-nth-page () widget
+    (assistant assistant)
+    (page-num int))
+  
+  (defbinding %assistant-insert-page () int
+    (assistant assistant)
+    (page widget)
+    (pos int))
+
+  (defun assistant-insert-page (assistant page position &rest child-args)    
+    (let ((pos (case position
+		 (:first 0)
+		 (:last -1)
+		 (t position))))
+      (prog1
+	  (%assistant-insert-page assistant page pos)
+	(init-child-slots assistant page child-args))))
+  
+  (defun assistant-append-page (assistant page &rest child-args)
+    (apply #'assistant-insert-page assistant page :last child-args))
+  
+  (defun assistant-prepend-page (assistant page &rest child-args)
+    (apply #'assistant-insert-page assistant page :first child-args))
+
+  (define-callback-marshal %assistant-page-func-callback int
+    ((current-page int)))
+
+  (defbinding assistant-set-forward-func (assistant function) nil
+    (assistant assistant)
+    (%assistant-page-func-callback callback)
+    ((register-callback-function function) pointer-data)
+    (user-data-destroy-callback callback))
+
+  (defbinding assistant-add-action-widget () nil
+    (assistant assistant)
+    (child widget))
+
+  (defbinding assistant-remove-action-widget () nil
+    (assistant assistant)
+    (child widget))
+
+  (defbinding assistant-update-buttons-state () nil
+    (assistant assistant)))
+
+
+
 ;;; Aspect frame
 
 
@@ -1358,7 +1410,7 @@
   (prog1
       (if display
 	  (apply #'call-next-method
-	   window :screen (gdk:display-get-default-screen display) initargs)
+	   window :screen (gdk:display-get-default-screen (gdk:ensure-display display)) initargs)
 	(call-next-method))
     (initial-add window #'window-add-accel-group 
      initargs :accel-group :accel-groups)))
@@ -1400,13 +1452,14 @@
 
 (defbinding %window-set-geometry-hints () nil
   (window window)
+  (widget (or widget null))
   (geometry gdk:geometry)
   (geometry-mask gdk:window-hints))
 
-(defun window-set-geometry-hints (window &key min-width min-height
+(defun window-set-geometry-hints (window &key widget 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)
+				  width-inc height-inc gravity
+				  aspect (min-aspect aspect) (max-aspect aspect))
   (let ((geometry (make-instance 'gdk:geometry 
 		   :min-width (or min-width -1)
 		   :min-height (or min-height -1)
@@ -1417,12 +1470,11 @@
 		   :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))
+		   :max-aspect (or max-aspect 0)))
 	(mask ()))
-    (when (or min-size min-width min-height)
+    (when (or min-width min-height)
       (push :min-size mask))
-    (when (or max-size max-width max-height)
+    (when (or max-width max-height)
       (push :max-size mask))
     (when (or base-width base-height)
       (push :base-size mask))
@@ -1430,9 +1482,10 @@
       (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)))
+    (when gravity
+      (push :win-gravity mask)
+      (setf (gdk:geometry-gravity geometry) gravity))
+    (%window-set-geometry-hints window widget geometry mask)))
 
 (defbinding window-list-toplevels () (glist (copy-of window))
   "Returns a list of all existing toplevel windows.")