1 ;; Common Lisp bindings for GTK+ v2.0
2 ;; Copyright (C) 1999-2005 Espen S. Johnsen <espen@users.sf.net>
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: gtktree.lisp,v 1.7 2005-02-27 19:56:06 espen Exp $
26 (defbinding cell-layout-pack-start () nil
27 (cell-layout cell-layout)
31 (defbinding cell-layout-pack-end () nil
32 (cell-layout cell-layout)
36 (defun cell-layout-pack (layout cell &key end expand)
38 (cell-layout-pack-end layout cell expand)
39 (cell-layout-pack-start layout cell expand)))
42 (defbinding cell-layout-reorder () nil
43 (cell-layout cell-layout)
47 (defbinding cell-layout-clear () nil
48 (cell-layout cell-layout))
50 (defbinding cell-layout-add-attribute
51 (cell-layout cell attribute column &optional model) nil
52 (cell-layout cell-layout)
54 ((string-downcase attribute) string)
55 ((if model (column-index model column) column) int))
57 (def-callback-marshal %cell-layout-data-func
58 (nil cell-layout cell-renderer tree-model (copy-of tree-iter)))
60 (defbinding cell-layout-set-cell-data-func (cell-layout cell function) nil
61 (cell-layout cell-layout)
63 ((callback %cell-layout-data-func) pointer)
64 ((register-callback-function function) unsigned-int)
65 ((callback user-data-destroy-func) pointer))
67 (defbinding cell-layout-clear-attributes () nil
68 (cell-layout cell-layout)
75 (defmethod initialize-instance ((list-store list-store) &key column-types
76 column-names initial-content)
78 (%list-store-set-column-types list-store column-types)
80 (setf (object-data list-store 'column-names) column-names))
83 with iter = (make-instance 'tree-iter)
84 for row in initial-content
85 do (list-store-append list-store row iter))))
88 (defmethod column-setter-name ((list-store list-store))
89 (declare (ignore list-store))
92 (defbinding %list-store-set-column-types () nil
93 (list-store list-store)
94 ((length columns) unsigned-int)
95 (columns (vector gtype)))
97 (defbinding %list-store-remove () boolean
98 (list-store list-store)
99 (tree-iter tree-iter))
101 (defun list-store-remove (store row)
104 (%list-store-remove store row))
106 (multiple-value-bind (valid iter) (tree-model-get-iter store row)
108 (%list-store-remove store iter)
109 (error "~A not poiniting to av valid iterator in ~A" row store))))
111 (let ((path (tree-row-reference-get-path row)))
113 (list-store-remove store path)
114 (error "~A not valid" row))))))
117 (defbinding %list-store-insert () nil
118 (list-store list-store)
119 (tree-iter tree-iter)
122 (defun list-store-insert
123 (store position &optional data (iter (make-instance 'tree-iter)))
124 (%list-store-insert store iter position)
125 (when data (%tree-model-set store iter data))
128 (defbinding %list-store-insert-before () nil
129 (list-store list-store)
130 (tree-iter tree-iter)
131 (sibling (or null tree-iter)))
133 (defun list-store-insert-before
134 (store sibling &optional data (iter (make-instance 'tree-iter)))
135 (%list-store-insert-before store iter sibling)
136 (when data (%tree-model-set store iter data))
139 (defbinding %list-store-insert-after
140 (list-store &optional sibling (tree-iter (make-instance 'tree-iter))) nil
141 (list-store list-store)
142 (tree-iter tree-iter)
143 (sibling (or null tree-iter)))
145 (defun list-store-insert-after
146 (store sibling &optional data (iter (make-instance 'tree-iter)))
147 (%list-store-insert-after store iter sibling)
148 (when data (%tree-model-set store iter data))
151 (defbinding %list-store-prepend () nil
152 (list-store list-store)
153 (tree-iter tree-iter))
155 (defun list-store-prepend
156 (store &optional data (iter (make-instance 'tree-iter)))
157 (%list-store-prepend store iter)
158 (when data (%tree-model-set store iter data))
161 (defbinding %list-store-append () nil
162 (list-store list-store)
163 (tree-iter tree-iter))
165 (defun list-store-append
166 (store &optional data (iter (make-instance 'tree-iter)))
167 (%list-store-append store iter)
168 (when data (%tree-model-set store iter data))
171 (defbinding list-store-clear () nil
172 (list-store list-store))
174 (defbinding list-store-reorder () nil
175 (list-store list-store)
176 (new-order (vector int)))
178 (defbinding list-store-swap () nil
179 (list-store list-store)
183 (defbinding list-store-move-before () nil
184 (list-store list-store)
186 (psoition (or null tree-iter)))
188 (defbinding list-store-move-after () nil
189 (list-store list-store)
191 (psoition tree-iter))
196 (defbinding %tree-path-free () nil
199 (defbinding %tree-path-get-indices () pointer
202 (defbinding %tree-path-get-depth () int
205 (defun %make-tree-path (path)
206 (let ((c-vector (make-c-vector 'int (length path) path))
207 (location (allocate-memory (+ (size-of 'int) (size-of 'pointer)))))
208 (funcall (writer-function 'int) (length path) location)
209 (funcall (writer-function 'pointer) c-vector location (size-of 'int))
212 (defun %tree-path-to-vector (location)
213 (let ((indices (%tree-path-get-indices location))
214 (depth (%tree-path-get-depth location)))
215 (if (null-pointer-p indices)
217 (map-c-vector 'vector #'identity indices 'int depth))))
219 (eval-when (:compile-toplevel :load-toplevel :execute)
220 (defmethod alien-type ((type (eql 'tree-path)) &rest args)
221 (declare (ignore type args))
222 (alien-type 'pointer))
224 (defmethod size-of ((type (eql 'tree-path)) &rest args)
225 (declare (ignore type args))
228 (defmethod to-alien-form (path (type (eql 'tree-path)) &rest args)
229 (declare (ignore type args))
230 `(%make-tree-path ,path))
232 (defmethod from-alien-form (location (type (eql 'tree-path)) &rest args)
233 (declare (ignore type args))
234 `(let ((location ,location))
236 (%tree-path-to-vector location)
237 (%tree-path-free location))))
239 (defmethod copy-from-alien-form (location (type (eql 'tree-path)) &rest args)
240 (declare (ignore type args))
241 `(%tree-path-to-vector ,location))
243 (defmethod cleanup-form (location (type (eql 'tree-path)) &rest args)
244 (declare (ignore type args))
245 `(%tree-path-free ,location)))
247 (defmethod to-alien-function ((type (eql 'tree-path)) &rest args)
248 (declare (ignore type args))
251 (defmethod from-alien-function ((type (eql 'tree-path)) &rest args)
252 (declare (ignore type args))
255 (%tree-path-to-vector location)
256 (%tree-path-free location))))
258 (defmethod copy-from-alien-function ((type (eql 'tree-path)) &rest args)
259 (declare (ignore type args))
260 #'%tree-path-to-vector)
262 (defmethod cleanup-function ((type (eql 'tree-path)) &rest args)
263 (declare (ignore type args))
266 (defmethod writer-function ((type (eql 'tree-path)) &rest args)
267 (declare (ignore type args))
268 (let ((writer (writer-function 'pointer)))
269 #'(lambda (path location &optional (offset 0))
270 (funcall writer (%make-tree-path path) location offset))))
272 (defmethod reader-function ((type (eql 'tree-path)) &rest args)
273 (declare (ignore type args))
274 (let ((reader (reader-function 'pointer)))
275 #'(lambda (location &optional (offset 0))
276 (%tree-path-to-vector (funcall reader location offset)))))
279 (defbinding %tree-row-reference-new () pointer
283 (defmethod initialize-instance ((reference tree-row-reference) &key model path)
285 (slot-value reference 'location)
286 (%tree-row-reference-new model path))
289 (defbinding tree-row-reference-get-path () tree-path
290 (reference tree-row-reference))
292 (defbinding (tree-row-reference-valid-p "gtk_tree_row_reference_valid") () boolean
293 (reference tree-row-reference))
296 (defbinding tree-model-get-column-type () gtype ;type-number
297 (tree-model tree-model)
300 (defbinding tree-model-get-iter
301 (model path &optional (iter (make-instance 'tree-iter))) boolean
303 (iter tree-iter :return)
306 (defbinding tree-model-get-path () tree-path
307 (tree-model tree-model)
310 (defbinding %tree-model-get-value () nil
311 (tree-model tree-model)
316 (defun tree-model-column-value (model iter column)
317 (let ((index (column-index model column)))
318 (with-gvalue (gvalue)
319 (%tree-model-get-value model iter index gvalue))))
321 (defbinding tree-model-iter-next () boolean
322 (tree-model tree-model)
323 (iter tree-iter :return))
325 (defbinding tree-model-iter-children
326 (tree-model parent &optional (iter (make-instance 'tree-iter))) boolean
327 (tree-model tree-model)
328 (iter tree-iter :return)
329 (parent (or null tree-iter)))
331 (defbinding (tree-model-iter-has-child-p "gtk_tree_model_iter_has_child")
333 (tree-model tree-model)
336 (defbinding tree-model-iter-n-children () int
337 (tree-model tree-model)
340 (defbinding tree-model-iter-nth-child
341 (tree-model parent n &optional (iter (make-instance 'tree-iter))) boolean
342 (tree-model tree-model)
343 (iter tree-iter :return)
344 (parent (or null tree-iter))
347 (defbinding tree-model-iter-parent
348 (tree-model child &optional (iter (make-instance 'tree-iter))) boolean
349 (tree-model tree-model)
350 (iter tree-iter :return)
353 (def-callback-marshal %tree-model-foreach-func
354 (boolean tree-model (path (copy-of tree-path)) (iter (copy-of tree-iter))))
356 (defbinding %tree-model-foreach () nil
357 (tree-model tree-model)
358 ((callback %tree-model-foreach-func) pointer)
359 (callback-id unsigned-int))
361 (defun tree-model-foreach (model function)
362 (with-callback-function (id function)
363 (%tree-model-foreach model id)))
365 (defbinding tree-model-row-changed () nil
366 (tree-model tree-model)
370 (defbinding tree-model-row-inserted () nil
371 (tree-model tree-model)
375 (defbinding tree-model-row-has-child-toggled () nil
376 (tree-model tree-model)
380 (defbinding tree-model-row-deleted () nil
381 (tree-model tree-model)
385 (defbinding tree-model-rows-reordered () nil
386 (tree-model tree-model)
392 (defun column-types (model columns)
395 (find-type-number (first (mklist column))))
398 (defun column-index (model column)
402 (symbol (position column (object-data model 'column-names)))
403 (string (position column (object-data model 'column-names)
405 (error "~A has no column ~S" model column)))
407 (defun tree-model-column-value-setter (model column)
409 (object-data model 'column-setters)
411 (object-data model 'column-setters)
412 (make-array (tree-model-n-columns model)
413 :initial-element nil)))))
414 (let ((index (column-index model column)))
416 (svref setters index)
418 (svref setters index)
420 (mkbinding (column-setter-name model)
421 nil (type-of model) 'tree-iter 'int
422 ; (type-from-number (tree-model-get-column-type model index))
423 (tree-model-get-column-type model index)
425 #'(lambda (value iter)
426 (funcall setter model iter index value -1))))))))
428 (defun tree-model-row-setter (model)
430 (object-data model 'row-setter)
432 ;; This will create any missing column setter
434 for i from 0 below (tree-model-n-columns model)
435 do (tree-model-column-value-setter model i))
436 (let ((setters (object-data model 'column-setters)))
438 (object-data model 'row-setter)
440 (map nil #'(lambda (value setter)
441 (funcall setter value iter))
444 (defun (setf tree-model-column-value) (value model iter column)
445 (funcall (tree-model-column-value-setter model column) value iter)
448 (defun (setf tree-model-row-data) (data model iter)
449 (funcall (tree-model-row-setter model) data iter)
452 (defun %tree-model-set (model iter data)
454 (vector (setf (tree-model-row-data model iter) data))
457 as (column value . rest) = data then rest
458 do (setf (tree-model-column-value model iter column) value)
464 (def-callback-marshal %tree-selection-func (boolean tree-selection tree-model (path (copy-of tree-path)) (path-currently-selected boolean)))
466 (defbinding tree-selection-set-select-function (selection function) nil
467 (selection tree-selection)
468 ((callback %tree-selection-func) pointer)
469 ((register-callback-function function) unsigned-int)
470 ((callback user-data-destroy-func) pointer))
472 (defbinding tree-selection-get-selected
473 (selection &optional (iter (make-instance 'tree-iter))) boolean
474 (selection tree-selection)
476 (iter tree-iter :return))
478 (def-callback-marshal %tree-selection-foreach-func (nil tree-model (path (copy-of tree-path)) (iter (copy-of tree-iter))))
480 (defbinding %tree-selection-selected-foreach () nil
481 (tree-selection tree-selection)
482 ((callback %tree-selection-foreach-func) pointer)
483 (callback-id unsigned-int))
485 (defun tree-selection-selected-foreach (selection function)
486 (with-callback-function (id function)
487 (%tree-selection-selected-foreach selection id)))
489 (defbinding tree-selection-get-selected-rows () (glist tree-path)
490 (tree-selection tree-selection)
493 (defbinding tree-selection-count-selected-rows () int
494 (tree-selection tree-selection))
496 (defbinding %tree-selection-select-path () nil
497 (tree-selection tree-selection)
498 (tree-path tree-path))
500 (defbinding %tree-selection-unselect-path () nil
501 (tree-selection tree-selection)
502 (tree-path tree-path))
504 (defbinding %tree-selection-path-is-selected () boolean
505 (tree-selection tree-selection)
506 (tree-path tree-path))
508 (defbinding %tree-selection-select-iter () nil
509 (tree-selection tree-selection)
510 (tree-path tree-path))
512 (defbinding %tree-selection-unselect-iter () nil
513 (tree-selection tree-selection)
514 (tree-path tree-path))
516 (defbinding %tree-selection-iter-is-selected () boolean
517 (tree-selection tree-selection)
518 (tree-path tree-path))
520 (defun tree-selection-select (selection row)
522 (tree-path (%tree-selection-select-path selection row))
523 (tree-iter (%tree-selection-select-iter selection row))))
525 (defun tree-selection-unselect (selection row)
527 (tree-path (%tree-selection-unselect-path selection row))
528 (tree-iter (%tree-selection-unselect-iter selection row))))
530 (defun tree-selection-is-selected-p (selection row)
532 (tree-path (%tree-selection-path-is-selected selection row))
533 (tree-iter (%tree-selection-iter-is-selected selection row))))
535 (defbinding tree-selection-select-all () nil
536 (tree-selection tree-selection))
538 (defbinding tree-selection-unselect-all () nil
539 (tree-selection tree-selection))
541 (defbinding tree-selection-select-range () nil
542 (tree-selection tree-selection)
546 (defbinding tree-selection-unselect-range () nil
547 (tree-selection tree-selection)
555 (defbinding %tree-store-set-column-types () nil
556 (tree-store tree-store)
557 ((length columns) unsigned-int)
558 (columns (vector gtype)))
560 (defmethod initialize-instance ((tree-store tree-store) &key column-types
563 (%tree-store-set-column-types tree-store column-types)
565 (setf (object-data tree-store 'column-names) column-names)))
567 (defmethod column-setter-name ((tree-store tree-store))
568 (declare (ignore tree-store))
569 "gtk_tree_store_set")
571 (defbinding tree-store-remove () boolean
572 (tree-store tree-store)
573 (tree-iter tree-iter))
575 (defbinding %tree-store-insert () nil
576 (tree-store tree-store)
577 (tree-iter tree-iter)
578 (parent (or null tree-iter))
581 (defun tree-store-insert
582 (store parent position &optional data (iter (make-instance 'tree-iter)))
583 (%tree-store-insert store iter parent position)
584 (when data (%tree-model-set store iter data))
587 (defbinding %tree-store-insert-before () nil
588 (tree-store tree-store)
589 (tree-iter tree-iter)
590 (parent (or null tree-iter))
591 (sibling (or null tree-iter)))
593 (defun tree-store-insert-before
594 (store parent sibling &optional data (iter (make-instance 'tree-iter)))
595 (%tree-store-insert-before store iter parent sibling)
596 (when data (%tree-model-set store iter data))
599 (defbinding %tree-store-insert-after () nil
600 (tree-store tree-store)
601 (tree-iter tree-iter)
602 (parent (or null tree-iter))
603 (sibling (or null tree-iter)))
605 (defun tree-store-insert-after
606 (store parent sibling &optional data (iter (make-instance 'tree-iter)))
607 (%tree-store-insert-after store iter parent sibling)
608 (when data (%tree-model-set store iter data))
611 (defbinding %tree-store-prepend () nil
612 (tree-store tree-store)
613 (tree-iter tree-iter)
614 (parent (or null tree-iter)))
616 (defun tree-store-prepend
617 (store parent &optional data (iter (make-instance 'tree-iter)))
618 (%tree-store-prepend store iter parent)
619 (when data (%tree-model-set store iter data))
622 (defbinding %tree-store-append () nil
623 (tree-store tree-store)
624 (tree-iter tree-iter)
625 (parent (or null tree-iter)))
627 (defun tree-store-append
628 (store parent &optional data (iter (make-instance 'tree-iter)))
629 (%tree-store-append store iter parent)
630 (when data (%tree-model-set store iter data))
633 (defbinding (tree-store-is-ancestor-p "gtk_tree_store_is_ancestor") () boolean
634 (tree-store tree-store)
635 (tree-iter tree-iter)
636 (descendant tree-iter))
638 (defbinding tree-store-iter-depth () int
639 (tree-store tree-store)
640 (tree-iter tree-iter))
642 (defbinding tree-store-clear () nil
643 (tree-store tree-store))
645 (defbinding tree-store-reorder () nil
646 (tree-store tree-store)
648 (new-order (vector int)))
650 (defbinding tree-store-swap () nil
651 (tree-store tree-store)
655 (defbinding tree-store-move-before () nil
656 (tree-store tree-store)
658 (psoition (or null tree-iter)))
661 (defbinding tree-store-move-after () nil
662 (tree-store tree-store)
664 (psoition tree-iter))
670 (defmethod initialize-instance ((tree-view tree-view) &rest initargs
673 (mapc #'(lambda (column)
674 (tree-view-append-column tree-view column))
675 (get-all initargs :column)))
678 (defbinding tree-view-columns-autosize () nil
679 (tree-view tree-view))
681 (defbinding tree-view-append-column () int
682 (tree-view tree-view)
683 (tree-view-column tree-view-column))
685 (defbinding tree-view-remove-column () int
686 (tree-view tree-view)
687 (tree-view-column tree-view-column))
689 (defbinding tree-view-insert-column (view column position) int
691 (column tree-view-column)
692 ((if (eq position :end) -1 position) int))
694 (defbinding tree-view-get-column () tree-view-column
695 (tree-view tree-view)
698 (defbinding tree-view-move-column-after () nil
699 (tree-view tree-view)
700 (column tree-view-column)
701 (base-column (or null tree-view-column)))
703 ;;(defbinding tree-view-set-column drag-function ...)
705 (defbinding tree-view-scroll-to-point () nil
706 (tree-view tree-view)
710 (defbinding tree-view-scroll-to-cell () nil
711 (tree-view tree-view)
712 (path (or null tree-path))
713 (column (or null tree-view-column))
715 (row-align single-float)
716 (col-align single-float))
718 (defbinding tree-view-set-cursor () nil
719 (tree-view tree-view)
721 (focus-column tree-view-column)
722 (start-editing boolean))
724 (defbinding tree-view-set-cursor-on-cell () nil
725 (tree-view tree-view)
727 (focus-column (or null tree-view-column))
728 (focus-cell (or null cell-renderer))
729 (start-editing boolean))
731 (defbinding tree-view-get-cursor () nil
732 (tree-view tree-view)
733 (path tree-path :out )
734 (focus-column tree-view-column :out))
736 (defbinding tree-view-row-activated () nil
737 (tree-view tree-view)
739 (column tree-view-column))
741 (defbinding tree-view-expand-all () nil
742 (tree-view tree-view))
744 (defbinding tree-view-collapse-all () nil
745 (tree-view tree-view))
747 (defbinding tree-view-expand-to-path () nil
748 (tree-view tree-view)
751 (defbinding tree-view-expand-row () nil
752 (tree-view tree-view)
756 (defbinding tree-view-collapse-row () nil
757 (tree-view tree-view)
760 (def-callback-marshal %tree-view-mapping-func (nil tree-view (path (copy-of tree-path))))
762 (defbinding %tree-view-map-expanded-rows () nil
763 (tree-view tree-view)
764 ((callback %tree-view-mapping-func) pointer)
765 (callback-id unsigned-int))
767 (defun map-expanded-rows (function tree-view)
768 (with-callback-function (id function)
769 (%tree-view-map-expanded-rows tree-view id)))
771 (defbinding (tree-view-row-expanded-p "gtk_tree_view_row_expanded") () boolean
772 (tree-view tree-view)
775 (defbinding tree-view-get-path-at-pos
776 (tree-view x y &optional (cell-x 0) (cell-y 0)) boolean
777 (tree-view tree-view)
780 (path tree-path :out)
781 (column tree-view-column :out)
785 (defbinding tree-view-get-cell-area () nil
786 (tree-view tree-view)
787 (path (or null tree-path))
788 (column (or null tree-view-column))
789 ((make-instance 'gdk:rectangle) gdk:rectangle :return))
791 (defbinding tree-view-get-background-area () nil
792 (tree-view tree-view)
793 (path (or null tree-path))
794 (column (or null tree-view-column))
795 ((make-instance 'gdk:rectangle) gdk:rectangle :return))
797 (defbinding tree-view-get-visible-rect () nil
798 (tree-view tree-view)
799 ((make-instance 'gdk:rectangle) gdk:rectangle :return))
801 ;; and many more functions which we'll add later