1 ;; Common Lisp bindings for GTK+ v2.0
2 ;; Copyright (C) 2000 Espen S. Johnsen <espejohn@online.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.2 2000-10-05 17:21: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)))))
42 (define-foreign ("gtk_container_child_getv" container-child-get-arg) () nil
48 (define-foreign ("gtk_container_child_setv" container-child-set-arg) () nil
54 (defun container-child-arg (container child name)
56 (let ((arg (arg-new 0)))
57 (setf (arg-name arg) name)
58 (container-child-get-arg container child arg) ; probably memory leak
59 (let ((type (type-from-number (arg-type arg))))
62 (arg-free arg nil))))))
64 (defun (setf container-child-arg) (value container child name)
66 (let ((arg (arg-new 0)))
67 (setf (arg-name arg) name)
68 (container-child-get-arg container child arg) ; probably memory leak
69 (let ((type (type-from-number (arg-type arg))))
70 (setf (arg-value arg type) value)
71 (container-child-set-arg container child arg)
76 (define-foreign container-add () nil
80 (define-foreign container-remove () nil
84 (define-foreign container-check-resize () nil
85 (container container))
87 (define-foreign ("gtk_container_foreach_full" %container-foreach)
88 (container function) nil
91 (*callback-marshal* pointer)
92 ((register-callback-function function) unsigned-long)
93 (*destroy-marshal* pointer))
95 (defun map-container (seqtype func container)
98 (%container-foreach container func)
105 (push (funcall func child) list)))
108 (let ((seq (make-sequence seqtype (container-num-children container)))
113 (setf (elt seq index) (funcall func child))
117 (defmacro do-container ((var container &optional (result nil)) &body body)
118 (let ((continue (make-symbol "CONTINUE")))
119 `(let ((,continue t))
127 (setq ,continue t)))))
130 (define-foreign container-children () (glist widget)
131 (container container))
133 (defun (setf container-children) (children container)
134 (dolist (child (container-children container))
135 (container-remove container child))
136 (dolist (child children)
137 (container-add container child))
140 ;; Should be implemented as a foreign function
141 (defun container-num-children (container)
142 (length (container-children container)))
144 (define-foreign container-resize-children () nil
145 (container container))