X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/d2ba9d8606444090f642bbceab7ce2b9b903e6e3..580820d8044f45eb58f39b9d52d185d2efd16bcd:/gtk/gtkcontainer.lisp

diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp
index a6981c6..da076f0 100644
--- a/gtk/gtkcontainer.lisp
+++ b/gtk/gtkcontainer.lisp
@@ -15,14 +15,20 @@
 ;; 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: gtkcontainer.lisp,v 1.15 2004-12-29 21:14:23 espen Exp $
+;; $Id: gtkcontainer.lisp,v 1.17 2005-02-22 23:08:52 espen Exp $
 
 (in-package "GTK")
 
-
 (defmethod shared-initialize ((container container) names &rest initargs 
-			      &key child children child-args)
+			      &key child children child-args 
+			           (show-children nil show-children-p))
   (declare (ignore child children))
+  (when show-children-p
+    (if (not show-children)
+	(setf (user-data container 'show-recursive-p) nil)
+      (signal-connect container 'show #'container-show-recursive 
+       :object t :remove t)))
+
   (call-next-method)
   (initial-add container 
    #'(lambda (container args) 
@@ -30,6 +36,15 @@ (defmethod shared-initialize ((container container) names &rest initargs
    initargs :child :children))
 
 
+(defmethod compute-signal-function ((container container) signal function object)
+  (if (eq object :children)
+      #'(lambda (&rest args)
+	  (mapc #'(lambda (child)
+		    (apply function child (rest args)))
+		(container-children container)))
+    (call-next-method)))
+
+
 (defbinding %container-add () nil
   (container container)
   (widget widget))
@@ -44,7 +59,6 @@ (defmethod container-add ((container container) (widget widget) &rest args)
       (gethash (class-of container) *container-to-child-class-mappings*)
       :parent container :child widget args))))
 
-
 (defbinding %container-remove () nil
   (container container)
   (widget widget))
@@ -159,3 +173,16 @@ (defun (setf container-focus-chain) (focusable-widgets container)
   (if (null focusable-widgets)
       (%container-unset-focus-chain container)
     (%container-set-focus-chain container focusable-widgets)))
+
+(defgeneric container-show-recursive (container))
+
+(defmethod container-show-recursive ((container container))
+  "Recursively shows any child widgets except widgets explicit hidden during construction."
+  (labels ((recursive-show (widget)
+	     (when (typep widget 'container)
+	       (if (not (user-data-p widget 'show-recursive-p))
+		   (container-foreach widget #'recursive-show)
+		 (unset-user-data widget 'show-recursive-p)))
+	     (unless (widget-hidden-p widget)
+	       (widget-show widget))))
+    (container-foreach container #'recursive-show)))