Instances of TREE-ITER properly allocated as memory slices
[clg] / gtk / gtktree.lisp
CommitLineData
55212af1 1;; Common Lisp bindings for GTK+ v2.x
2;; Copyright 2004-2005 Espen S. Johnsen <espen@users.sf.net>
985713d7 3;;
55212af1 4;; Permission is hereby granted, free of charge, to any person obtaining
5;; a copy of this software and associated documentation files (the
6;; "Software"), to deal in the Software without restriction, including
7;; without limitation the rights to use, copy, modify, merge, publish,
8;; distribute, sublicense, and/or sell copies of the Software, and to
9;; permit persons to whom the Software is furnished to do so, subject to
10;; the following conditions:
985713d7 11;;
55212af1 12;; The above copyright notice and this permission notice shall be
13;; included in all copies or substantial portions of the Software.
985713d7 14;;
55212af1 15;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
16;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
17;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
18;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
19;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
20;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22
9fb0a6d3 23;; $Id: gtktree.lisp,v 1.31 2007/10/17 14:47:10 espen Exp $
985713d7 24
25
26(in-package "GTK")
27
28
29;;;; Cell Layout
30
31(defbinding cell-layout-pack-start () nil
32 (cell-layout cell-layout)
33 (cell cell-renderer)
34 (expand boolean))
35
36(defbinding cell-layout-pack-end () nil
37 (cell-layout cell-layout)
38 (cell cell-renderer)
39 (expand boolean))
40
41(defun cell-layout-pack (layout cell &key end expand)
42 (if end
43 (cell-layout-pack-end layout cell expand)
44 (cell-layout-pack-start layout cell expand)))
45
4e169141 46
985713d7 47(defbinding cell-layout-reorder () nil
48 (cell-layout cell-layout)
49 (cell cell-renderer)
50 (position int))
51
52(defbinding cell-layout-clear () nil
53 (cell-layout cell-layout))
54
da82be16 55(defbinding cell-layout-add-attribute (cell-layout cell attribute column) nil
985713d7 56 (cell-layout cell-layout)
57 (cell cell-renderer)
58 ((string-downcase attribute) string)
da82be16 59 (column int))
985713d7 60
a92553bd 61(define-callback-marshal %cell-layout-data-callback nil
62 (cell-layout cell-renderer tree-model tree-iter))
985713d7 63
64(defbinding cell-layout-set-cell-data-func (cell-layout cell function) nil
65 (cell-layout cell-layout)
66 (cell cell-renderer)
a92553bd 67 (%cell-layout-data-callback callback)
985713d7 68 ((register-callback-function function) unsigned-int)
a92553bd 69 (user-data-destroy-callback callback))
985713d7 70
71(defbinding cell-layout-clear-attributes () nil
72 (cell-layout cell-layout)
73 (cell cell-renderer))
74
75
038891cf 76;;;; Cell Renderer
77
f335841f 78(defmethod compute-signal-function ((gobject cell-renderer-toggle) (signal (eql 'toggled)) function object args)
79 (declare (ignore gobject signal function object args))
038891cf 80 (let ((function (call-next-method)))
81 #'(lambda (object path)
82 (funcall function object (ensure-tree-path path)))))
83
985713d7 84
85;;;; List Store
86
4e169141 87(defmethod initialize-instance ((list-store list-store) &key column-types
88 column-names initial-content)
985713d7 89 (call-next-method)
4e169141 90 (%list-store-set-column-types list-store column-types)
91 (when column-names
70b52c33 92 (setf
1e5e3e14 93 (user-data list-store 'column-names)
70b52c33 94 (coerce column-names 'vector)))
4e169141 95 (when initial-content
96 (loop
97 with iter = (make-instance 'tree-iter)
98 for row in initial-content
99 do (list-store-append list-store row iter))))
985713d7 100
985713d7 101
4e169141 102(defbinding %list-store-set-column-types () nil
985713d7 103 (list-store list-store)
4e169141 104 ((length columns) unsigned-int)
105 (columns (vector gtype)))
985713d7 106
eb0b609d 107(defbinding list-store-remove (store row) boolean
108 (store list-store)
109 ((ensure-tree-iter store row) tree-iter))
110
111(defbinding %list-store-set-value () nil
985713d7 112 (list-store list-store)
eb0b609d 113 (tree-iter tree-iter)
114 (column int)
115 (gvalue gvalue))
985713d7 116
eb0b609d 117(defmethod (setf tree-model-value) (value (store list-store) row column)
118 (let* ((index (tree-model-column-index store column))
119 (type (tree-model-get-column-type store index)))
120 (with-gvalue (gvalue type value)
121 (%list-store-set-value store (ensure-tree-iter store row) index gvalue)))
122 value)
05a3b9e4 123
eb0b609d 124(defbinding %list-store-insert-with-valuesv () nil
125 (list-store list-store)
126 (tree-iter tree-iter)
127 (position int)
128 (columns (vector int))
129 (gvalues pointer)
130 ((length columns) int))
05a3b9e4 131
4e169141 132(defbinding %list-store-insert () nil
985713d7 133 (list-store list-store)
4e169141 134 (tree-iter tree-iter)
985713d7 135 (position int))
136
eb0b609d 137(defun list-store-insert (store position &optional data (iter (make-instance 'tree-iter)))
138 (etypecase data
139 (null (%list-store-insert store iter position))
140
141 (list (with-memory (gvalues (* (/ (length data) 2) +gvalue-size+))
142 (let ((columns
143 (loop
144 for (column value) on data by #'cddr
145 as index = (tree-model-column-index store column)
146 as type = (tree-model-get-column-type store index)
147 as gvalue = gvalues then (pointer+ gvalue +gvalue-size+)
148 do (gvalue-init gvalue type value)
149 collect index)))
150 (unwind-protect
151 (%list-store-insert-with-valuesv store iter position columns gvalues)
152 (loop
153 repeat (length columns)
154 as gvalue = gvalues then (pointer+ gvalue +gvalue-size+)
155 do (gvalue-unset gvalue))))))
156
157 (vector (with-memory (gvalues (* (length data) +gvalue-size+))
158 (let ((columns
159 (loop
160 for index below (length data)
161 as type = (tree-model-get-column-type store index)
162 as gvalue = gvalues then (pointer+ gvalue +gvalue-size+)
163 do (gvalue-init gvalue type (aref data index))
164 collect index)))
165 (unwind-protect
166 (%list-store-insert-with-valuesv store iter position columns gvalues))
167 (loop
168 repeat (length data)
169 as gvalue = gvalues then (pointer+ gvalue +gvalue-size+)
170 do (gvalue-unset gvalue))))))
4e169141 171 iter)
172
173(defbinding %list-store-insert-before () nil
985713d7 174 (list-store list-store)
4e169141 175 (tree-iter tree-iter)
985713d7 176 (sibling (or null tree-iter)))
177
4e169141 178(defun list-store-insert-before
179 (store sibling &optional data (iter (make-instance 'tree-iter)))
180 (%list-store-insert-before store iter sibling)
eb0b609d 181 (when data (setf (tree-model-row-data store iter) data))
4e169141 182 iter)
183
63dbd868 184(defbinding %list-store-insert-after () nil
985713d7 185 (list-store list-store)
4e169141 186 (tree-iter tree-iter)
985713d7 187 (sibling (or null tree-iter)))
188
4e169141 189(defun list-store-insert-after
190 (store sibling &optional data (iter (make-instance 'tree-iter)))
191 (%list-store-insert-after store iter sibling)
eb0b609d 192 (when data (setf (tree-model-row-data store iter) data))
4e169141 193 iter)
194
195(defbinding %list-store-prepend () nil
985713d7 196 (list-store list-store)
4e169141 197 (tree-iter tree-iter))
198
199(defun list-store-prepend
200 (store &optional data (iter (make-instance 'tree-iter)))
201 (%list-store-prepend store iter)
eb0b609d 202 (when data (setf (tree-model-row-data store iter) data))
4e169141 203 iter)
985713d7 204
4e169141 205(defbinding %list-store-append () nil
985713d7 206 (list-store list-store)
4e169141 207 (tree-iter tree-iter))
208
209(defun list-store-append
210 (store &optional data (iter (make-instance 'tree-iter)))
211 (%list-store-append store iter)
eb0b609d 212 (when data (setf (tree-model-row-data store iter) data))
4e169141 213 iter)
985713d7 214
215(defbinding list-store-clear () nil
216 (list-store list-store))
217
218(defbinding list-store-reorder () nil
219 (list-store list-store)
220 (new-order (vector int)))
221
222(defbinding list-store-swap () nil
223 (list-store list-store)
224 (a tree-iter)
225 (b tree-iter))
226
227(defbinding list-store-move-before () nil
228 (list-store list-store)
229 (iter tree-iter)
230 (psoition (or null tree-iter)))
231
985713d7 232(defbinding list-store-move-after () nil
233 (list-store list-store)
234 (iter tree-iter)
235 (psoition tree-iter))
236
237
eb0b609d 238;;; Tree Path
985713d7 239
4e169141 240(defbinding %tree-path-free () nil
241 (location pointer))
242
243(defbinding %tree-path-get-indices () pointer
244 (location pointer))
245
246(defbinding %tree-path-get-depth () int
247 (location pointer))
248
249(defun %make-tree-path (path)
928e2b4e 250 (let* ((c-vector (make-c-vector 'int (length path) :content path))
251 (pointer-offset (adjust-offset (size-of 'int) 'pointer))
252 (location (allocate-memory (+ pointer-offset (size-of 'pointer)))))
4e169141 253 (funcall (writer-function 'int) (length path) location)
928e2b4e 254 (funcall (writer-function 'pointer) c-vector location pointer-offset)
4e169141 255 location))
256
05a3b9e4 257(defun %tree-path-to-vector (location)
b66270aa 258 (unless (null-pointer-p location)
259 (let ((indices (%tree-path-get-indices location))
260 (depth (%tree-path-get-depth location)))
261 (if (null-pointer-p indices)
262 #()
263 (map-c-vector 'vector #'identity indices 'int depth)))))
4e169141 264
1e5e3e14 265(defmacro %with-tree-path ((var path) &body body)
928e2b4e 266 (let* ((pointer-offset (adjust-offset (size-of 'int) 'pointer))
267 (vector-offset (adjust-offset (+ pointer-offset (size-of 'pointer)) 'int)))
268 `(with-memory (,var (+ ,vector-offset (* ,(size-of 'int) (length ,path))))
1e5e3e14 269 (funcall (writer-function 'int) (length ,path) ,var)
928e2b4e 270 (setf (ref-pointer ,var ,pointer-offset) (pointer+ ,var ,vector-offset))
1e5e3e14 271 (make-c-vector 'int (length ,path) :content ,path :location (pointer+ ,var ,vector-offset))
272 ,@body)))
273
4e169141 274(eval-when (:compile-toplevel :load-toplevel :execute)
4d1fea77 275 (define-type-method alien-type ((type tree-path))
276 (declare (ignore type))
4e169141 277 (alien-type 'pointer))
278
1e5e3e14 279 (define-type-method size-of ((type tree-path) &key inlined)
280 (assert-not-inlined type inlined)
4e169141 281 (size-of 'pointer))
282
1e5e3e14 283 (define-type-method alien-arg-wrapper ((type tree-path) var path style form &optional copy-in-p)
4d1fea77 284 (declare (ignore type))
1e5e3e14 285 (cond
286 ((and (in-arg-p style) copy-in-p)
287 `(with-pointer (,var (%make-tree-path ,path))
288 ,form))
289 ((and (in-arg-p style) (not (out-arg-p style)))
290 `(%with-tree-path (,var ,path)
291 ,form))
292 ((and (in-arg-p style) (out-arg-p style))
293 (let ((tree-path (make-symbol "SYMBOL")))
294 `(%with-tree-path (,tree-path ,path)
295 (with-pointer (,var ,tree-path)
296 ,form))))
297 ((and (out-arg-p style) (not (in-arg-p style)))
298 `(with-pointer (,var)
299 ,form))))
300
301 (define-type-method to-alien-form ((type tree-path) path &optional copy-p)
302 (declare (ignore type copy-p))
4e169141 303 `(%make-tree-path ,path))
304
1e5e3e14 305 (define-type-method from-alien-form ((type tree-path) location &key (ref :free))
4d1fea77 306 (declare (ignore type))
1e5e3e14 307 `(prog1
308 (%tree-path-to-vector ,location)
309 ,(when (eq ref :free)
310 `(%tree-path-free ,location)))))
4e169141 311
1e5e3e14 312(define-type-method to-alien-function ((type tree-path) &optional copy-p)
4d1fea77 313 (declare (ignore type))
1e5e3e14 314 #'%make-tree-path
315 (unless copy-p
316 #'(lambda (tree-path location)
317 (declare (ignore tree-path))
05a3b9e4 318 (%tree-path-free location))))
05a3b9e4 319
1e5e3e14 320(define-type-method from-alien-function ((type tree-path) &key (ref :free))
4d1fea77 321 (declare (ignore type))
1e5e3e14 322 (if (eq ref :free)
323 #'(lambda (location)
324 (prog1
325 (%tree-path-to-vector location)
326 (%tree-path-free location)))
327 #'(lambda (location)
328 (%tree-path-to-vector location))))
329
330(define-type-method writer-function ((type tree-path) &key temp inlined)
331 (declare (ignore temp))
332 (assert-not-inlined type inlined)
05a3b9e4 333 (let ((writer (writer-function 'pointer)))
334 #'(lambda (path location &optional (offset 0))
335 (funcall writer (%make-tree-path path) location offset))))
336
1e5e3e14 337(define-type-method reader-function ((type tree-path) &key ref inlined)
338 (declare (ignore ref))
339 (assert-not-inlined type inlined)
340 #'(lambda (location &optional (offset 0))
341 (%tree-path-to-vector (ref-pointer location offset))))
4e169141 342
1e5e3e14 343(define-type-method destroy-function ((type tree-path) &key temp inlined)
344 (declare (ignore temp))
345 (assert-not-inlined type inlined)
346 #'(lambda (location &optional (offset 0))
347 (%tree-path-free (ref-pointer location offset))))
c8211115 348
6beb5074 349(defun ensure-tree-path (path)
350 (etypecase path
351 (string (coerce (clg-utils:split-string path :delimiter #\:) 'vector))
352 (vector path)))
353
4e169141 354
eb0b609d 355;;; Tree Model
356
f335841f 357(defgeneric tree-model-value (model row column))
358(defgeneric (setf tree-model-value) (value model row column))
359(defgeneric tree-model-row-data (model row))
360(defgeneric (setf tree-model-row-data) (data model row))
361(defgeneric tree-model-column-index (model column))
362(defgeneric tree-model-column-name (model index))
363
364
4e169141 365(defbinding %tree-row-reference-new () pointer
366 (model tree-model)
367 (path tree-path))
368
39db92d4 369(defmethod allocate-foreign ((reference tree-row-reference) &key model path)
370 (%tree-row-reference-new model path))
4e169141 371
372(defbinding tree-row-reference-get-path () tree-path
373 (reference tree-row-reference))
374
375(defbinding (tree-row-reference-valid-p "gtk_tree_row_reference_valid") () boolean
376 (reference tree-row-reference))
377
378
eb0b609d 379(defbinding tree-model-get-column-type () gtype
4e169141 380 (tree-model tree-model)
381 (index int))
382
eb0b609d 383(defbinding tree-model-get-iter (model path &optional (iter (make-instance 'tree-iter))) boolean
4e169141 384 (model tree-model)
1e5e3e14 385 (iter tree-iter :in/return)
4e169141 386 (path tree-path))
9fb0a6d3 387
388(defmethod allocate-foreign ((tree-iter tree-iter) &rest initargs)
389 (declare (ignore initargs))
390 (let ((size (foreign-size (class-of tree-iter))))
391 (slice-alloc size)))
4e169141 392
eb0b609d 393(defun ensure-tree-iter (model row)
394 (etypecase row
395 (tree-iter row)
396 (tree-path
397 (multiple-value-bind (valid-p iter) (tree-model-get-iter model row)
398 (if valid-p
399 iter
400 (error "Invalid tree path for ~A: ~A" model row))))
401 (tree-row-reference
402 (let ((path (tree-row-reference-get-path row)))
403 (if path
404 (ensure-tree-iter model path)
405 (error "~A not valid" row))))))
406
4e169141 407(defbinding tree-model-get-path () tree-path
408 (tree-model tree-model)
409 (iter tree-iter))
410
411(defbinding %tree-model-get-value () nil
412 (tree-model tree-model)
413 (iter tree-iter)
414 (column int)
415 (gvalue gvalue))
416
70b52c33 417(defmethod tree-model-value ((model tree-model) row column)
eb0b609d 418 (let ((index (tree-model-column-index model column)))
780a4e24 419 (with-gvalue (gvalue)
eb0b609d 420 (%tree-model-get-value model (ensure-tree-iter model row) index gvalue))))
421
eb0b609d 422(defmethod tree-model-row-data ((model tree-model) row)
423 (coerce
424 (loop
425 with iter = (ensure-tree-iter model row)
985e276d 426 for index from 0 below (tree-model-n-columns model)
eb0b609d 427 collect (tree-model-value model iter index))
428 'vector))
429
4e169141 430
431(defbinding tree-model-iter-next () boolean
432 (tree-model tree-model)
1e5e3e14 433 (iter tree-iter :in/return))
4e169141 434
435(defbinding tree-model-iter-children
436 (tree-model parent &optional (iter (make-instance 'tree-iter))) boolean
437 (tree-model tree-model)
1e5e3e14 438 (iter tree-iter :in/return)
4e169141 439 (parent (or null tree-iter)))
440
441(defbinding (tree-model-iter-has-child-p "gtk_tree_model_iter_has_child")
442 () boolean
443 (tree-model tree-model)
444 (iter tree-iter))
445
ee950f05 446(defbinding tree-model-iter-n-children (tree-model &optional iter) int
4e169141 447 (tree-model tree-model)
ee950f05 448 (iter (or null tree-iter)))
4e169141 449
450(defbinding tree-model-iter-nth-child
3d36c5d6 451 (tree-model parent n &optional (iter (make-instance 'tree-iter))) boolean
4e169141 452 (tree-model tree-model)
1e5e3e14 453 (iter tree-iter :in/return)
4e169141 454 (parent (or null tree-iter))
455 (n int))
456
457(defbinding tree-model-iter-parent
458 (tree-model child &optional (iter (make-instance 'tree-iter))) boolean
459 (tree-model tree-model)
1e5e3e14 460 (iter tree-iter :in/return)
4e169141 461 (child tree-iter))
462
a92553bd 463(define-callback-marshal %tree-model-foreach-callback boolean
464 (tree-model tree-path tree-iter))
4e169141 465
a92553bd 466(defbinding %tree-model-foreach (tree-model callback-id) nil
4e169141 467 (tree-model tree-model)
a92553bd 468 (%tree-model-foreach-callback callback)
4e169141 469 (callback-id unsigned-int))
470
471(defun tree-model-foreach (model function)
472 (with-callback-function (id function)
473 (%tree-model-foreach model id)))
474
475(defbinding tree-model-row-changed () nil
476 (tree-model tree-model)
477 (path tree-path)
478 (iter tree-iter))
479
480(defbinding tree-model-row-inserted () nil
481 (tree-model tree-model)
482 (path tree-path)
483 (iter tree-iter))
484
485(defbinding tree-model-row-has-child-toggled () nil
486 (tree-model tree-model)
487 (path tree-path)
488 (iter tree-iter))
489
490(defbinding tree-model-row-deleted () nil
491 (tree-model tree-model)
492 (path tree-path)
493 (iter tree-iter))
494
495(defbinding tree-model-rows-reordered () nil
496 (tree-model tree-model)
497 (path tree-path)
498 (iter tree-iter)
499 (new-order int))
500
eb0b609d 501(defmethod tree-model-column-index ((model tree-model) column)
4e169141 502 (or
503 (etypecase column
504 (number column)
eb0b609d 505 (string (position column (user-data model 'column-names) :test #'string=))
506 (symbol (position column (user-data model 'column-names))))
4e169141 507 (error "~A has no column ~S" model column)))
508
eb0b609d 509(defmethod tree-model-column-name ((model tree-model) index)
1e5e3e14 510 (svref (user-data model 'column-names) index))
da82be16 511
4e169141 512
eb0b609d 513(defmethod (setf tree-model-row-data) ((data list) (model tree-model) (iter tree-iter))
514 (loop
515 for (column value) on data by #'cddr
516 do (setf (tree-model-value model iter column) value))
4e169141 517 data)
518
eb0b609d 519(defmethod (setf tree-model-row-data) ((data vector) (model tree-model) row)
520 (loop
521 with iter = (ensure-tree-iter model row)
522 for index from 0
523 for value across data
524 do (setf (tree-model-value model iter index) value))
525 data)
985713d7 526
527
05a3b9e4 528;;; Tree Selection
529
a92553bd 530(define-callback-marshal %tree-selection-callback boolean
531 (tree-selection tree-model tree-path (path-currently-selected boolean)))
05a3b9e4 532
533(defbinding tree-selection-set-select-function (selection function) nil
534 (selection tree-selection)
a92553bd 535 (%tree-selection-callback callback)
05a3b9e4 536 ((register-callback-function function) unsigned-int)
a92553bd 537 (user-data-destroy-callback callback))
05a3b9e4 538
539(defbinding tree-selection-get-selected
540 (selection &optional (iter (make-instance 'tree-iter))) boolean
541 (selection tree-selection)
542 (nil null)
1e5e3e14 543 (iter tree-iter :in/return))
05a3b9e4 544
a92553bd 545(define-callback-marshal %tree-selection-foreach-callback nil (tree-model tree-path tree-iter))
05a3b9e4 546
a92553bd 547(defbinding %tree-selection-selected-foreach (tree-selection callback-id) nil
05a3b9e4 548 (tree-selection tree-selection)
a92553bd 549 (%tree-selection-foreach-callback callback)
05a3b9e4 550 (callback-id unsigned-int))
551
552(defun tree-selection-selected-foreach (selection function)
553 (with-callback-function (id function)
554 (%tree-selection-selected-foreach selection id)))
555
556(defbinding tree-selection-get-selected-rows () (glist tree-path)
557 (tree-selection tree-selection)
558 (nil null))
559
560(defbinding tree-selection-count-selected-rows () int
561 (tree-selection tree-selection))
562
563(defbinding %tree-selection-select-path () nil
564 (tree-selection tree-selection)
565 (tree-path tree-path))
566
567(defbinding %tree-selection-unselect-path () nil
568 (tree-selection tree-selection)
569 (tree-path tree-path))
570
571(defbinding %tree-selection-path-is-selected () boolean
572 (tree-selection tree-selection)
573 (tree-path tree-path))
574
575(defbinding %tree-selection-select-iter () nil
576 (tree-selection tree-selection)
577 (tree-path tree-path))
578
579(defbinding %tree-selection-unselect-iter () nil
580 (tree-selection tree-selection)
581 (tree-path tree-path))
582
583(defbinding %tree-selection-iter-is-selected () boolean
584 (tree-selection tree-selection)
585 (tree-path tree-path))
586
587(defun tree-selection-select (selection row)
588 (etypecase row
589 (tree-path (%tree-selection-select-path selection row))
590 (tree-iter (%tree-selection-select-iter selection row))))
591
592(defun tree-selection-unselect (selection row)
593 (etypecase row
594 (tree-path (%tree-selection-unselect-path selection row))
595 (tree-iter (%tree-selection-unselect-iter selection row))))
596
597(defun tree-selection-is-selected-p (selection row)
598 (etypecase row
599 (tree-path (%tree-selection-path-is-selected selection row))
600 (tree-iter (%tree-selection-iter-is-selected selection row))))
601
602(defbinding tree-selection-select-all () nil
603 (tree-selection tree-selection))
604
605(defbinding tree-selection-unselect-all () nil
606 (tree-selection tree-selection))
607
608(defbinding tree-selection-select-range () nil
609 (tree-selection tree-selection)
610 (start tree-path)
611 (end tree-path))
612
613(defbinding tree-selection-unselect-range () nil
614 (tree-selection tree-selection)
615 (start tree-path)
616 (end tree-path))
617
618
da82be16 619;;; Tree Sortable
620
621(eval-when (:compile-toplevel :load-toplevel :execute)
622 (define-enum-type sort-column (:default -1) (:unsorted -2))
623 (define-enum-type sort-order (:before -1) (:equal 0) (:after 1)))
624
625
a92553bd 626(define-callback-marshal %tree-iter-compare-callback (or int sort-order)
627 (tree-model (a tree-iter) (b tree-iter)))
da82be16 628
629(defbinding tree-sortable-sort-column-changed () nil
630 (sortable tree-sortable))
631
632(defbinding %tree-sortable-get-sort-column-id () boolean
633 (sortable tree-sortable)
634 (column int :out)
635 (order sort-type :out))
636
637(defun tree-sortable-get-sort-column (sortable)
638 (multiple-value-bind (special-p column order)
639 (%tree-sortable-get-sort-column-id sortable)
640 (values
641 (if special-p
642 (int-to-sort-order column)
cc4896ef 643 (tree-model-column-name sortable column))
da82be16 644 order)))
645
646(defbinding (tree-sortable-set-sort-column
647 "gtk_tree_sortable_set_sort_column_id")
648 (sortable column order) nil
649 (sortable tree-sortable)
650 ((etypecase column
651 ((or integer sort-column) column)
eb0b609d 652 (symbol (tree-model-column-index sortable column)))
da82be16 653 (or sort-column int))
654 (order sort-type))
655
656(defbinding %tree-sortable-set-sort-func (sortable column function) nil
657 (sortable tree-sortable)
eb0b609d 658 ((tree-model-column-index sortable column) int)
a92553bd 659 (%tree-iter-compare-callback callback)
da82be16 660 ((register-callback-function function) unsigned-int)
a92553bd 661 (user-data-destroy-callback callback))
da82be16 662
663(defbinding %tree-sortable-set-default-sort-func () nil
664 (sortable tree-sortable)
a92553bd 665 (compare-func (or null callback))
da82be16 666 (callback-id unsigned-int)
a92553bd 667 (destroy-func (or null callback)))
da82be16 668
669(defun tree-sortable-set-sort-func (sortable column function)
670 "Sets the comparison function used when sorting to be FUNCTION. If
671the current sort column of SORTABLE is the same as COLUMN,
672then the model will sort using this function."
673 (cond
674 ((and (eq column :default) (not function))
675 (%tree-sortable-set-default-sort-func sortable nil 0 nil))
676 ((eq column :default)
677 (%tree-sortable-set-default-sort-func sortable
a92553bd 678 %tree-iter-compare-callback
da82be16 679 (register-callback-function function)
a92553bd 680 user-data-destroy-callback))
da82be16 681 ((%tree-sortable-set-sort-func sortable column function))))
682
683(defbinding tree-sortable-has-default-sort-func-p () boolean
684 (sortable tree-sortable))
685
05a3b9e4 686
985713d7 687;;; Tree Store
688
689(defbinding %tree-store-set-column-types () nil
690 (tree-store tree-store)
4e169141 691 ((length columns) unsigned-int)
692 (columns (vector gtype)))
985713d7 693
4e169141 694(defmethod initialize-instance ((tree-store tree-store) &key column-types
695 column-names)
985713d7 696 (call-next-method)
4e169141 697 (%tree-store-set-column-types tree-store column-types)
698 (when column-names
1e5e3e14 699 (setf (user-data tree-store 'column-names) column-names)))
985713d7 700
eb0b609d 701
702(defbinding %tree-store-set-value () nil
703 (tree-store tree-store)
704 (tree-iter tree-iter)
705 (column int)
706 (gvalue gvalue))
707
708(defmethod (setf tree-model-value) (value (store tree-store) row column)
709 (let* ((index (tree-model-column-index store column))
710 (type (tree-model-get-column-type store index)))
711 (with-gvalue (gvalue type value)
712 (%tree-store-set-value store (ensure-tree-iter store row) index gvalue)))
713 value)
714
985713d7 715
716(defbinding tree-store-remove () boolean
717 (tree-store tree-store)
718 (tree-iter tree-iter))
719
4e169141 720(defbinding %tree-store-insert () nil
985713d7 721 (tree-store tree-store)
4e169141 722 (tree-iter tree-iter)
985713d7 723 (parent (or null tree-iter))
724 (position int))
725
4e169141 726(defun tree-store-insert
727 (store parent position &optional data (iter (make-instance 'tree-iter)))
728 (%tree-store-insert store iter parent position)
eb0b609d 729 (when data (setf (tree-model-row-data store iter) data))
4e169141 730 iter)
731
732(defbinding %tree-store-insert-before () nil
985713d7 733 (tree-store tree-store)
4e169141 734 (tree-iter tree-iter)
985713d7 735 (parent (or null tree-iter))
736 (sibling (or null tree-iter)))
737
3d36c5d6 738(defun tree-store-insert-before
4e169141 739 (store parent sibling &optional data (iter (make-instance 'tree-iter)))
740 (%tree-store-insert-before store iter parent sibling)
eb0b609d 741 (when data (setf (tree-model-row-data store iter) data))
4e169141 742 iter)
743
744(defbinding %tree-store-insert-after () nil
985713d7 745 (tree-store tree-store)
4e169141 746 (tree-iter tree-iter)
985713d7 747 (parent (or null tree-iter))
748 (sibling (or null tree-iter)))
749
4e169141 750(defun tree-store-insert-after
751 (store parent sibling &optional data (iter (make-instance 'tree-iter)))
752 (%tree-store-insert-after store iter parent sibling)
eb0b609d 753 (when data (setf (tree-model-row-data store iter) data))
4e169141 754 iter)
755
756(defbinding %tree-store-prepend () nil
985713d7 757 (tree-store tree-store)
4e169141 758 (tree-iter tree-iter)
985713d7 759 (parent (or null tree-iter)))
760
4e169141 761(defun tree-store-prepend
762 (store parent &optional data (iter (make-instance 'tree-iter)))
763 (%tree-store-prepend store iter parent)
eb0b609d 764 (when data (setf (tree-model-row-data store iter) data))
4e169141 765 iter)
766
767(defbinding %tree-store-append () nil
985713d7 768 (tree-store tree-store)
4e169141 769 (tree-iter tree-iter)
985713d7 770 (parent (or null tree-iter)))
771
4e169141 772(defun tree-store-append
773 (store parent &optional data (iter (make-instance 'tree-iter)))
774 (%tree-store-append store iter parent)
eb0b609d 775 (when data (setf (tree-model-row-data store iter) data))
4e169141 776 iter)
777
985713d7 778(defbinding (tree-store-is-ancestor-p "gtk_tree_store_is_ancestor") () boolean
779 (tree-store tree-store)
780 (tree-iter tree-iter)
781 (descendant tree-iter))
782
783(defbinding tree-store-iter-depth () int
784 (tree-store tree-store)
785 (tree-iter tree-iter))
786
787(defbinding tree-store-clear () nil
788 (tree-store tree-store))
789
790(defbinding tree-store-reorder () nil
791 (tree-store tree-store)
792 (parent tree-iter)
793 (new-order (vector int)))
794
795(defbinding tree-store-swap () nil
796 (tree-store tree-store)
797 (a tree-iter)
798 (b tree-iter))
799
800(defbinding tree-store-move-before () nil
801 (tree-store tree-store)
802 (iter tree-iter)
803 (psoition (or null tree-iter)))
804
805
806(defbinding tree-store-move-after () nil
807 (tree-store tree-store)
808 (iter tree-iter)
809 (psoition tree-iter))
810
811
812
813;;; Tree View
814
05a3b9e4 815(defmethod initialize-instance ((tree-view tree-view) &rest initargs
816 &key column)
4d1fea77 817 (declare (ignore column))
4e169141 818 (call-next-method)
819 (mapc #'(lambda (column)
820 (tree-view-append-column tree-view column))
821 (get-all initargs :column)))
822
823
985713d7 824(defbinding tree-view-columns-autosize () nil
825 (tree-view tree-view))
826
827(defbinding tree-view-append-column () int
828 (tree-view tree-view)
829 (tree-view-column tree-view-column))
830
831(defbinding tree-view-remove-column () int
832 (tree-view tree-view)
833 (tree-view-column tree-view-column))
834
3d36c5d6 835(defbinding tree-view-insert-column (view column position) int
985713d7 836 (view tree-view)
837 (column tree-view-column)
838 ((if (eq position :end) -1 position) int))
839
840(defbinding tree-view-get-column () tree-view-column
841 (tree-view tree-view)
842 (position int))
843
844(defbinding tree-view-move-column-after () nil
845 (tree-view tree-view)
846 (column tree-view-column)
847 (base-column (or null tree-view-column)))
848
63dbd868 849(define-callback-setter tree-view-set-column-drag-function tree-view boolean
850 (column tree-view-column)
851 (prev tree-view-column)
852 (next tree-view-column))
985713d7 853
854(defbinding tree-view-scroll-to-point () nil
855 (tree-view tree-view)
856 (tree-x int)
857 (tree-y int))
858
859(defbinding tree-view-scroll-to-cell () nil
860 (tree-view tree-view)
861 (path (or null tree-path))
862 (column (or null tree-view-column))
863 (use-align boolean)
864 (row-align single-float)
865 (col-align single-float))
866
63dbd868 867(defbinding (tree-view-set-cursor "gtk_tree_view_set_cursor_on_cell")
868 (tree-view path &key focus-column focus-cell start-editing) nil
985713d7 869 (tree-view tree-view)
870 (path tree-path)
871 (focus-column (or null tree-view-column))
872 (focus-cell (or null cell-renderer))
873 (start-editing boolean))
874
875(defbinding tree-view-get-cursor () nil
876 (tree-view tree-view)
877 (path tree-path :out )
878 (focus-column tree-view-column :out))
879
880(defbinding tree-view-row-activated () nil
881 (tree-view tree-view)
882 (path tree-path )
883 (column tree-view-column))
884
885(defbinding tree-view-expand-all () nil
886 (tree-view tree-view))
887
888(defbinding tree-view-collapse-all () nil
889 (tree-view tree-view))
890
891(defbinding tree-view-expand-to-path () nil
892 (tree-view tree-view)
893 (path tree-path))
894
895(defbinding tree-view-expand-row () nil
896 (tree-view tree-view)
897 (path tree-path)
898 (open-all boolean))
899
900(defbinding tree-view-collapse-row () nil
901 (tree-view tree-view)
902 (path tree-path))
903
a92553bd 904(define-callback-marshal %tree-view-mapping-callback nil (tree-view tree-path))
985713d7 905
a92553bd 906(defbinding %tree-view-map-expanded-rows (tree-view callback-id) nil
985713d7 907 (tree-view tree-view)
a92553bd 908 (%tree-view-mapping-callback callback)
985713d7 909 (callback-id unsigned-int))
910
911(defun map-expanded-rows (function tree-view)
912 (with-callback-function (id function)
913 (%tree-view-map-expanded-rows tree-view id)))
914
915(defbinding (tree-view-row-expanded-p "gtk_tree_view_row_expanded") () boolean
916 (tree-view tree-view)
917 (path tree-path))
918
919(defbinding tree-view-get-path-at-pos
920 (tree-view x y &optional (cell-x 0) (cell-y 0)) boolean
921 (tree-view tree-view)
922 (x int)
923 (y int)
924 (path tree-path :out)
925 (column tree-view-column :out)
926 (cell-x int)
927 (cell-y int))
928
929(defbinding tree-view-get-cell-area () nil
930 (tree-view tree-view)
931 (path (or null tree-path))
932 (column (or null tree-view-column))
1e5e3e14 933 ((make-instance 'gdk:rectangle) gdk:rectangle :in/return))
985713d7 934
935(defbinding tree-view-get-background-area () nil
936 (tree-view tree-view)
937 (path (or null tree-path))
938 (column (or null tree-view-column))
1e5e3e14 939 ((make-instance 'gdk:rectangle) gdk:rectangle :in/return))
985713d7 940
941(defbinding tree-view-get-visible-rect () nil
942 (tree-view tree-view)
1e5e3e14 943 ((make-instance 'gdk:rectangle) gdk:rectangle :in/return))
985713d7 944
945;; and many more functions which we'll add later
946
4e169141 947
da82be16 948;;;; Icon View
949
1e5e3e14 950#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
da82be16 951(progn
952 (defbinding icon-view-get-path-at-pos () tree-path
953 (icon-view icon-view)
954 (x int) (y int))
4e169141 955
a92553bd 956 (define-callback-marshal %icon-view-foreach-callback nil (icon-view tree-path))
da82be16 957
a92553bd 958 (defbinding %icon-view-selected-foreach (icon-view callback-id) tree-path
da82be16 959 (icon-view icon-view)
a92553bd 960 (%icon-view-foreach-callback callback)
da82be16 961 (callback-id unsigned-int))
962
963 (defun icon-view-foreach (icon-view function)
964 (with-callback-function (id function)
965 (%icon-view-selected-foreach icon-view id)))
966
967 (defbinding icon-view-select-path () nil
968 (icon-view icon-view)
969 (path tree-path))
970
971 (defbinding icon-view-unselect-path () nil
972 (icon-view icon-view)
973 (path tree-path))
974
975 (defbinding icon-view-path-is-selected-p () boolean
976 (icon-view icon-view)
977 (path tree-path))
978
979 (defbinding icon-view-get-selected-items () (glist tree-path)
980 (icon-view icon-view))
981
982 (defbinding icon-view-select-all () nil
983 (icon-view icon-view))
984
985 (defbinding icon-view-unselect-all () nil
986 (icon-view icon-view))
987
988 (defbinding icon-view-item-activated () nil
989 (icon-view icon-view)
990 (path tree-path))
991
992 (defbinding %icon-view-set-text-column (column icon-view) nil
993 (icon-view icon-view)
994 ((if (integerp column)
995 column
eb0b609d 996 (tree-model-column-index (icon-view-model icon-view) column)) int))
da82be16 997
880f23cb 998 (defbinding %%icon-view-get-text-column () int
999 (icon-view icon-view))
1000
1001 (defun %icon-view-get-text-column (icon-view)
eb0b609d 1002 (tree-model-column-index
880f23cb 1003 (icon-view-model icon-view)
1004 (%%icon-view-get-text-column icon-view)))
1005
1006 (defun %icon-view-text-column-boundp (icon-view)
1007 (not (eql (%%icon-view-get-text-column icon-view) -1)))
1008
1009
da82be16 1010 (defbinding %icon-view-set-markup-column (column icon-view) nil
1011 (icon-view icon-view)
1012 ((if (integerp column)
1013 column
eb0b609d 1014 (tree-model-column-index (icon-view-model icon-view) column)) int))
da82be16 1015
880f23cb 1016 (defbinding %%icon-view-get-markup-column () int
1017 (icon-view icon-view))
1018
1019 (defun %icon-view-get-markup-column (icon-view)
eb0b609d 1020 (tree-model-column-index
880f23cb 1021 (icon-view-model icon-view)
1022 (%%icon-view-get-markup-column icon-view)))
1023
1024 (defun %icon-view-markup-column-boundp (icon-view)
1025 (not (eql (%%icon-view-get-markup-column icon-view) -1)))
1026
1027
da82be16 1028 (defbinding %icon-view-set-pixbuf-column (column icon-view) nil
1029 (icon-view icon-view)
1030 ((if (integerp column)
1031 column
eb0b609d 1032 (tree-model-column-index (icon-view-model icon-view) column)) int)))
92ba85d4 1033
880f23cb 1034 (defbinding %%icon-view-get-pixbuf-column () int
1035 (icon-view icon-view))
1036
1037 (defun %icon-view-get-pixbuf-column (icon-view)
eb0b609d 1038 (tree-model-column-index
880f23cb 1039 (icon-view-model icon-view)
1040 (%%icon-view-get-pixbuf-column icon-view)))
1041
1042 (defun %icon-view-pixbuf-column-boundp (icon-view)
1043 (not (eql (%%icon-view-get-pixbuf-column icon-view) -1)))
1044
1045
1e5e3e14 1046#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0")
92ba85d4 1047(progn
1048 (defbinding icon-view-get-item-at-pos () boolean
1049 (icon-view icon-view)
1050 (x int)
1051 (y int)
1052 (tree-path tree-path :out)
1053 (cell cell-renderer :out))
1054
1055 (defbinding icon-view-set-cursor (icon-view path &key cell start-editing) nil
1056 (icon-view icon-view)
1057 (path tree-path)
1058 (cell (or null cell-renderer))
1059 (start-editing boolean))
1060
1061 (defbinding icon-view-get-cursor () boolean
1062 (icon-view icon-view)
1063 (path tree-path :out)
1064 (cell cell-renderer :out))
1065
1066 (defbinding icon-view-get-dest-item-at-pos () boolean
1067 (icon-view icon-view)
1068 (drag-x int)
1069 (drag-y int)
1070 (tree-path tree-path :out)
1071 (pos drop-position :out))
1072
1073 (defbinding icon-view-create-drag-icon () gdk:pixmap
1074 (icon-view icon-view)
1075 (tree-path tree-path))
1076
1077 (defbinding icon-view-scroll-to-path (icon-view tree-path &key row-align column-align) nil
1078 (icon-view icon-view)
1079 (tree-path tree-path)
1080 ((or row-align column-align) boolean)
1081 (row-align single-float)
1082 (column-align single-float))
1083
1084 (defbinding icon-view-get-visible-range () boolean
1085 (icon-view icon-view)
1086 (start-path tree-path :out)
1087 (end-path tree-path :out))
1088
63dbd868 1089 (defbinding icon-view-enable-model-drag-source () nil
1090 (icon-view icon-view)
1091 (start-button-mask gdk:modifier-type)
1092 (targets (vector (inlined target-entry)))
1093 ((length targets) unsigned-int)
1094 (actions gdk:drag-action))
1095
1096 (defbinding icon-view-enable-model-drag-dest () nil
1097 (icon-view icon-view)
1098 (targets (vector (inlined target-entry)))
1099 ((length targets) unsigned-int)
1100 (actions gdk:drag-action))
92ba85d4 1101
1102 (defbinding icon-view-unset-model-drag-source () nil
1103 (icon-view icon-view))
1104
1105 (defbinding icon-view-unset-model-drag-dest () nil
1106 (icon-view icon-view)))