CMUCL will now use LOAD-FOREIGN to load shared libraries instead of the internal...

[clg] / gtk / gtkcontainer.lisp

diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp
index 010fca1c1440e73a67fe5a8ef2ef5fa8973e855d..e52594af6076747b09786f73fb0298ed863856ee 100644 (file)
--- 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)))