X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/03802c3c0b7fc68d0e14fe39a1adf637cefbf66d..8ab0db90ff4867ccaa730c9c089d9cc2a10e92bf:/gtk/gtkcontainer.lisp diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index 6729eb3..7e50f1c 100644 --- a/gtk/gtkcontainer.lisp +++ b/gtk/gtkcontainer.lisp @@ -1,28 +1,45 @@ -;; Common Lisp bindings for GTK+ v2.0 -;; Copyright (C) 2000 Espen S. Johnsen +;; Common Lisp bindings for GTK+ v2.x +;; Copyright 2000-2005 Espen S. Johnsen ;; -;; This library is free software; you can redistribute it and/or -;; modify it under the terms of the GNU Lesser General Public -;; License as published by the Free Software Foundation; either -;; version 2 of the License, or (at your option) any later version. +;; Permission is hereby granted, free of charge, to any person obtaining +;; a copy of this software and associated documentation files (the +;; "Software"), to deal in the Software without restriction, including +;; without limitation the rights to use, copy, modify, merge, publish, +;; distribute, sublicense, and/or sell copies of the Software, and to +;; permit persons to whom the Software is furnished to do so, subject to +;; the following conditions: ;; -;; This library is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; Lesser General Public License for more details. +;; The above copyright notice and this permission notice shall be +;; included in all copies or substantial portions of the Software. ;; -;; You should have received a copy of the GNU Lesser General Public -;; License along with this library; if not, write to the Free Software -;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: gtkcontainer.lisp,v 1.16 2005-01-06 21:00:53 espen Exp $ +;; $Id: gtkcontainer.lisp,v 1.20 2006-02-28 16:32:18 espen Exp $ (in-package "GTK") +(defgeneric container-add (container widget &rest args)) +(defgeneric container-remove (container widget)) +(defgeneric container-children (container)) +(defgeneric (setf container-children) (children container)) + (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 +47,8 @@ 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 +70,6 @@ (gethash (class-of container) *container-to-child-class-mappings*) :parent container :child widget args)))) - (defbinding %container-remove () nil (container container) (widget widget)) @@ -79,11 +95,11 @@ (defbinding container-check-resize () nil (container container)) -(def-callback-marshal %foreach-callback (nil widget)) +(define-callback-marshal %foreach-callback nil (widget)) (defbinding %container-foreach (container callback-id) nil (container container) - ((callback %foreach-callback) pointer) + (%foreach-callback callback) (callback-id unsigned-int)) (defun container-foreach (container function) @@ -92,7 +108,7 @@ (defbinding %container-forall (container callback-id) nil (container container) - ((callback %foreach-callback) pointer) + (%foreach-callback callback) (callback-id unsigned-int)) (defun container-forall (container function) @@ -168,3 +184,16 @@ (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)))