From 67b44e86de2985a3ba726d81ae42d8f8d5a384a2 Mon Sep 17 00:00:00 2001 Message-Id: <67b44e86de2985a3ba726d81ae42d8f8d5a384a2.1714964198.git.mdw@distorted.org.uk> From: Mark Wooding Date: Tue, 22 Feb 2005 23:08:52 +0000 Subject: [PATCH] Added :show-children initarg to container class Organization: Straylight/Edgeware From: espen --- gtk/gtkcontainer.lisp | 30 ++++++++++++++++++++++++------ 1 file changed, 24 insertions(+), 6 deletions(-) diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index 6729eb3..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.16 2005-01-06 21:00:53 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,8 +36,8 @@ (defmethod shared-initialize ((container container) names &rest initargs initargs :child :children)) -(defmethod create-callback-function ((container container) function arg1) - (if (eq arg1 :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))) @@ -53,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)) @@ -168,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))) -- [mdw]