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.3 2001-05-29 16:03:04 espen Exp $
23 (defmethod initialize-instance ((container container) &rest initargs
25 (declare (ignore initargs))
27 (dolist (child children)
30 (container-add container (first child))
32 (slot-value (first child) 'child-slots)
35 (slot-value (class-of container) 'child-class)
36 :parent container :child (first child) (cdr child))))
38 (container-add container child)))))
40 (defbinding %container-child-getv () nil
46 (defbinding %container-child-setv () nil
53 (defbinding container-add () nil
57 (defbinding container-remove () nil
61 (defbinding container-check-resize () nil
62 (container container))
64 (defbinding (%container-foreach "gtk_container_foreach_full")
65 (container function) nil
68 (*callback-marshal* pointer)
69 ((register-callback-function function) unsigned-long)
70 (*destroy-marshal* pointer))
72 (defun map-container (seqtype func container)
75 (%container-foreach container func)
82 (push (funcall func child) list)))
85 (let ((seq (make-sequence seqtype (container-num-children container)))
90 (setf (elt seq index) (funcall func child))
94 (defmacro do-container ((var container &optional (result nil)) &body body)
95 (let ((continue (make-symbol "CONTINUE")))
104 (setq ,continue t)))))
107 (defbinding container-children () (glist widget)
108 (container container))
110 (defun (setf container-children) (children container)
111 (dolist (child (container-children container))
112 (container-remove container child))
113 (dolist (child children)
114 (container-add container child))
117 ;; Should be implemented as a foreign function
118 (defun container-num-children (container)
119 (length (container-children container)))
121 (defbinding container-resize-children () nil
122 (container container))