1 ;; Common Lisp bindings for GTK+ v2.0
2 ;; Copyright (C) 2000 Espen S. Johnsen <esj@stud.cs.uit.no>
4 ;; This library is free software; you can redistribute it and/or
5 ;; modify it under the terms of the GNU Lesser General Public
6 ;; License as published by the Free Software Foundation; either
7 ;; version 2 of the License, or (at your option) any later version.
9 ;; This library is distributed in the hope that it will be useful,
10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;; Lesser General Public License for more details.
14 ;; You should have received a copy of the GNU Lesser General Public
15 ;; License along with this library; if not, write to the Free Software
16 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 ;; $Id: gtkcontainer.lisp,v 1.5 2001-10-25 08:16:17 espen Exp $
22 (defmethod initialize-instance ((container container) &rest initargs)
24 (dolist (child (get-all initargs :child))
25 (apply #'container-add container (mklist child))))
28 (defbinding %container-add () nil
32 (defun container-add (container widget &rest args)
33 (%container-add container widget)
36 (slot-value widget 'child-slots)
39 (gethash (class-of container) *container-to-child-class-mappings*)
40 :parent container :child widget args))))
43 (defbinding %container-remove () nil
47 (defun container-remove (container widget)
48 (%container-remove container widget)
49 (slot-makunbound widget 'child-slots))
52 (defbinding %container-child-get-property () nil
55 (property-name string)
58 (defbinding %container-child-set-property () nil
61 (property-name string)
65 (defbinding container-check-resize () nil
66 (container container))
68 (defbinding (%container-foreach "gtk_container_foreach_full")
69 (container function) nil
72 (*callback-marshal* pointer)
73 ((register-callback-function function) pointer)
74 (*destroy-marshal* pointer))
76 (defun map-container (seqtype func container)
79 (%container-foreach container func)
86 (push (funcall func child) list)))
89 (let ((seq (make-sequence seqtype (container-num-children container)))
94 (setf (elt seq index) (funcall func child))
98 (defmacro do-container ((var container &optional (result nil)) &body body)
99 (let ((continue (make-symbol "CONTINUE")))
100 `(let ((,continue t))
108 (setq ,continue t)))))
111 (defbinding %container-get-children () (glist widget)
112 (container container))
114 (defmethod container-children ((container container))
115 (%container-get-children container))
117 (defmethod (setf container-children) (children (container container))
118 (dolist (child (container-children container))
119 (container-remove container child))
120 (dolist (child children)
121 (container-add container child))
124 ;; Should be implemented as a foreign function
125 (defun container-num-children (container)
126 (length (container-children container)))
128 (defbinding container-resize-children () nil
129 (container container))