chiark / gitweb /
Infra: Rudimentary setup system.
[clg] / gtk / gtktree.lisp
CommitLineData
112ac1d3 1;; Common Lisp bindings for GTK+ v2.x
2;; Copyright 2004-2005 Espen S. Johnsen <espen@users.sf.net>
167450a3 3;;
112ac1d3 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:
167450a3 11;;
112ac1d3 12;; The above copyright notice and this permission notice shall be
13;; included in all copies or substantial portions of the Software.
167450a3 14;;
112ac1d3 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
7346106c 23;; $Id: gtktree.lisp,v 1.34 2008-04-11 20:53:32 espen Exp $
167450a3 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
2a8752b0 46
167450a3 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
78a17735 55(defbinding cell-layout-add-attribute (cell-layout cell attribute column) nil
167450a3 56 (cell-layout cell-layout)
57 (cell cell-renderer)
58 ((string-downcase attribute) string)
78a17735 59 (column int))
167450a3 60
56ccd5b7 61(define-callback-marshal %cell-layout-data-callback nil
62 (cell-layout cell-renderer tree-model tree-iter))
167450a3 63
64(defbinding cell-layout-set-cell-data-func (cell-layout cell function) nil
65 (cell-layout cell-layout)
66 (cell cell-renderer)
56ccd5b7 67 (%cell-layout-data-callback callback)
167450a3 68 ((register-callback-function function) unsigned-int)
56ccd5b7 69 (user-data-destroy-callback callback))
167450a3 70
71(defbinding cell-layout-clear-attributes () nil
72 (cell-layout cell-layout)
73 (cell cell-renderer))
74
75
88fb7daa 76;;;; Cell Renderer
77
b8de3ff8 78(defmethod compute-signal-function ((gobject cell-renderer-toggle) (signal (eql 'toggled)) function object args)
79 (declare (ignore gobject signal function object args))
88fb7daa 80 (let ((function (call-next-method)))
81 #'(lambda (object path)
82 (funcall function object (ensure-tree-path path)))))
83
167450a3 84
85;;;; List Store
86
2a8752b0 87(defmethod initialize-instance ((list-store list-store) &key column-types
88 column-names initial-content)
167450a3 89 (call-next-method)
2a8752b0 90 (%list-store-set-column-types list-store column-types)
91 (when column-names
cc9d465b 92 (setf
b6d4ac86 93 (user-data list-store 'column-names)
cc9d465b 94 (coerce column-names 'vector)))
2a8752b0 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))))
167450a3 100
167450a3 101
2a8752b0 102(defbinding %list-store-set-column-types () nil
167450a3 103 (list-store list-store)
2a8752b0 104 ((length columns) unsigned-int)
105 (columns (vector gtype)))
167450a3 106
030b4286 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
167450a3 112 (list-store list-store)
030b4286 113 (tree-iter tree-iter)
114 (column int)
115 (gvalue gvalue))
167450a3 116
030b4286 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)
f4175703 123
030b4286 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))
f4175703 131
2a8752b0 132(defbinding %list-store-insert () nil
167450a3 133 (list-store list-store)
2a8752b0 134 (tree-iter tree-iter)
167450a3 135 (position int))
136
030b4286 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))))))
2a8752b0 171 iter)
172
173(defbinding %list-store-insert-before () nil
167450a3 174 (list-store list-store)
2a8752b0 175 (tree-iter tree-iter)
167450a3 176 (sibling (or null tree-iter)))
177
2a8752b0 178(defun list-store-insert-before
179 (store sibling &optional data (iter (make-instance 'tree-iter)))
180 (%list-store-insert-before store iter sibling)
030b4286 181 (when data (setf (tree-model-row-data store iter) data))
2a8752b0 182 iter)
183
d53cf0ec 184(defbinding %list-store-insert-after () nil
167450a3 185 (list-store list-store)
2a8752b0 186 (tree-iter tree-iter)
167450a3 187 (sibling (or null tree-iter)))
188
2a8752b0 189(defun list-store-insert-after
190 (store sibling &optional data (iter (make-instance 'tree-iter)))
191 (%list-store-insert-after store iter sibling)
030b4286 192 (when data (setf (tree-model-row-data store iter) data))
2a8752b0 193 iter)
194
195(defbinding %list-store-prepend () nil
167450a3 196 (list-store list-store)
2a8752b0 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)
030b4286 202 (when data (setf (tree-model-row-data store iter) data))
2a8752b0 203 iter)
167450a3 204
2a8752b0 205(defbinding %list-store-append () nil
167450a3 206 (list-store list-store)
2a8752b0 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)
030b4286 212 (when data (setf (tree-model-row-data store iter) data))
2a8752b0 213 iter)
167450a3 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
167450a3 232(defbinding list-store-move-after () nil
233 (list-store list-store)
234 (iter tree-iter)
235 (psoition tree-iter))
236
237
030b4286 238;;; Tree Path
167450a3 239
2a8752b0 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)
960af18a 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)))))
2a8752b0 253 (funcall (writer-function 'int) (length path) location)
960af18a 254 (funcall (writer-function 'pointer) c-vector location pointer-offset)
2a8752b0 255 location))
256
f4175703 257(defun %tree-path-to-vector (location)
ff0f1f00 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)))))
2a8752b0 264
b6d4ac86 265(defmacro %with-tree-path ((var path) &body body)
960af18a 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))))
b6d4ac86 269 (funcall (writer-function 'int) (length ,path) ,var)
960af18a 270 (setf (ref-pointer ,var ,pointer-offset) (pointer+ ,var ,vector-offset))
b6d4ac86 271 (make-c-vector 'int (length ,path) :content ,path :location (pointer+ ,var ,vector-offset))
272 ,@body)))
273
2a8752b0 274(eval-when (:compile-toplevel :load-toplevel :execute)
75689fea 275 (define-type-method alien-type ((type tree-path))
276 (declare (ignore type))
2a8752b0 277 (alien-type 'pointer))
278
b6d4ac86 279 (define-type-method size-of ((type tree-path) &key inlined)
280 (assert-not-inlined type inlined)
2a8752b0 281 (size-of 'pointer))
282
b6d4ac86 283 (define-type-method alien-arg-wrapper ((type tree-path) var path style form &optional copy-in-p)
75689fea 284 (declare (ignore type))
b6d4ac86 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))
2a8752b0 303 `(%make-tree-path ,path))
304
b6d4ac86 305 (define-type-method from-alien-form ((type tree-path) location &key (ref :free))
75689fea 306 (declare (ignore type))
b6d4ac86 307 `(prog1
308 (%tree-path-to-vector ,location)
309 ,(when (eq ref :free)
310 `(%tree-path-free ,location)))))
2a8752b0 311
b6d4ac86 312(define-type-method to-alien-function ((type tree-path) &optional copy-p)
75689fea 313 (declare (ignore type))
b6d4ac86 314 #'%make-tree-path
315 (unless copy-p
316 #'(lambda (tree-path location)
317 (declare (ignore tree-path))
f4175703 318 (%tree-path-free location))))
f4175703 319
b6d4ac86 320(define-type-method from-alien-function ((type tree-path) &key (ref :free))
75689fea 321 (declare (ignore type))
b6d4ac86 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)
f4175703 333 (let ((writer (writer-function 'pointer)))
334 #'(lambda (path location &optional (offset 0))
335 (funcall writer (%make-tree-path path) location offset))))
336
b6d4ac86 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))))
2a8752b0 342
b6d4ac86 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))))
f433f8a7 348
cff201e7 349(defun ensure-tree-path (path)
350 (etypecase path
351 (string (coerce (clg-utils:split-string path :delimiter #\:) 'vector))
352 (vector path)))
353
2a8752b0 354
030b4286 355;;; Tree Model
356
b8de3ff8 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
2a8752b0 365(defbinding %tree-row-reference-new () pointer
366 (model tree-model)
367 (path tree-path))
368
9176d301 369(defmethod allocate-foreign ((reference tree-row-reference) &key model path)
370 (%tree-row-reference-new model path))
2a8752b0 371
7346106c 372(defbinding tree-row-reference-get-path () (or null tree-path)
2a8752b0 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
030b4286 379(defbinding tree-model-get-column-type () gtype
2a8752b0 380 (tree-model tree-model)
381 (index int))
382
030b4286 383(defbinding tree-model-get-iter (model path &optional (iter (make-instance 'tree-iter))) boolean
2a8752b0 384 (model tree-model)
b6d4ac86 385 (iter tree-iter :in/return)
2a8752b0 386 (path tree-path))
d892130b 387
2d7da5f0 388#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.12.0")
d892130b 389(defmethod allocate-foreign ((tree-iter tree-iter) &rest initargs)
390 (declare (ignore initargs))
391 (let ((size (foreign-size (class-of tree-iter))))
392 (slice-alloc size)))
2a8752b0 393
030b4286 394(defun ensure-tree-iter (model row)
395 (etypecase row
396 (tree-iter row)
397 (tree-path
398 (multiple-value-bind (valid-p iter) (tree-model-get-iter model row)
399 (if valid-p
400 iter
401 (error "Invalid tree path for ~A: ~A" model row))))
402 (tree-row-reference
403 (let ((path (tree-row-reference-get-path row)))
404 (if path
405 (ensure-tree-iter model path)
406 (error "~A not valid" row))))))
407
2a8752b0 408(defbinding tree-model-get-path () tree-path
409 (tree-model tree-model)
410 (iter tree-iter))
411
412(defbinding %tree-model-get-value () nil
413 (tree-model tree-model)
414 (iter tree-iter)
415 (column int)
416 (gvalue gvalue))
417
cc9d465b 418(defmethod tree-model-value ((model tree-model) row column)
030b4286 419 (let ((index (tree-model-column-index model column)))
0d46865d 420 (with-gvalue (gvalue)
030b4286 421 (%tree-model-get-value model (ensure-tree-iter model row) index gvalue))))
422
030b4286 423(defmethod tree-model-row-data ((model tree-model) row)
424 (coerce
425 (loop
426 with iter = (ensure-tree-iter model row)
5d7ab8e9 427 for index from 0 below (tree-model-n-columns model)
030b4286 428 collect (tree-model-value model iter index))
429 'vector))
430
2a8752b0 431
432(defbinding tree-model-iter-next () boolean
433 (tree-model tree-model)
b6d4ac86 434 (iter tree-iter :in/return))
2a8752b0 435
436(defbinding tree-model-iter-children
437 (tree-model parent &optional (iter (make-instance 'tree-iter))) boolean
438 (tree-model tree-model)
b6d4ac86 439 (iter tree-iter :in/return)
2a8752b0 440 (parent (or null tree-iter)))
441
442(defbinding (tree-model-iter-has-child-p "gtk_tree_model_iter_has_child")
443 () boolean
444 (tree-model tree-model)
445 (iter tree-iter))
446
995eb841 447(defbinding tree-model-iter-n-children (tree-model &optional iter) int
2a8752b0 448 (tree-model tree-model)
995eb841 449 (iter (or null tree-iter)))
2a8752b0 450
451(defbinding tree-model-iter-nth-child
73572c12 452 (tree-model parent n &optional (iter (make-instance 'tree-iter))) boolean
2a8752b0 453 (tree-model tree-model)
b6d4ac86 454 (iter tree-iter :in/return)
2a8752b0 455 (parent (or null tree-iter))
456 (n int))
457
458(defbinding tree-model-iter-parent
459 (tree-model child &optional (iter (make-instance 'tree-iter))) boolean
460 (tree-model tree-model)
b6d4ac86 461 (iter tree-iter :in/return)
2a8752b0 462 (child tree-iter))
463
56ccd5b7 464(define-callback-marshal %tree-model-foreach-callback boolean
465 (tree-model tree-path tree-iter))
2a8752b0 466
56ccd5b7 467(defbinding %tree-model-foreach (tree-model callback-id) nil
2a8752b0 468 (tree-model tree-model)
56ccd5b7 469 (%tree-model-foreach-callback callback)
2a8752b0 470 (callback-id unsigned-int))
471
472(defun tree-model-foreach (model function)
473 (with-callback-function (id function)
474 (%tree-model-foreach model id)))
475
476(defbinding tree-model-row-changed () nil
477 (tree-model tree-model)
478 (path tree-path)
479 (iter tree-iter))
480
481(defbinding tree-model-row-inserted () nil
482 (tree-model tree-model)
483 (path tree-path)
484 (iter tree-iter))
485
486(defbinding tree-model-row-has-child-toggled () nil
487 (tree-model tree-model)
488 (path tree-path)
489 (iter tree-iter))
490
491(defbinding tree-model-row-deleted () nil
492 (tree-model tree-model)
493 (path tree-path)
494 (iter tree-iter))
495
496(defbinding tree-model-rows-reordered () nil
497 (tree-model tree-model)
498 (path tree-path)
499 (iter tree-iter)
500 (new-order int))
501
030b4286 502(defmethod tree-model-column-index ((model tree-model) column)
2a8752b0 503 (or
504 (etypecase column
505 (number column)
030b4286 506 (string (position column (user-data model 'column-names) :test #'string=))
507 (symbol (position column (user-data model 'column-names))))
2a8752b0 508 (error "~A has no column ~S" model column)))
509
030b4286 510(defmethod tree-model-column-name ((model tree-model) index)
b6d4ac86 511 (svref (user-data model 'column-names) index))
78a17735 512
2a8752b0 513
030b4286 514(defmethod (setf tree-model-row-data) ((data list) (model tree-model) (iter tree-iter))
515 (loop
516 for (column value) on data by #'cddr
517 do (setf (tree-model-value model iter column) value))
2a8752b0 518 data)
519
030b4286 520(defmethod (setf tree-model-row-data) ((data vector) (model tree-model) row)
521 (loop
522 with iter = (ensure-tree-iter model row)
523 for index from 0
524 for value across data
525 do (setf (tree-model-value model iter index) value))
526 data)
167450a3 527
528
f4175703 529;;; Tree Selection
530
56ccd5b7 531(define-callback-marshal %tree-selection-callback boolean
532 (tree-selection tree-model tree-path (path-currently-selected boolean)))
f4175703 533
534(defbinding tree-selection-set-select-function (selection function) nil
535 (selection tree-selection)
56ccd5b7 536 (%tree-selection-callback callback)
f4175703 537 ((register-callback-function function) unsigned-int)
56ccd5b7 538 (user-data-destroy-callback callback))
f4175703 539
540(defbinding tree-selection-get-selected
541 (selection &optional (iter (make-instance 'tree-iter))) boolean
542 (selection tree-selection)
543 (nil null)
b6d4ac86 544 (iter tree-iter :in/return))
f4175703 545
56ccd5b7 546(define-callback-marshal %tree-selection-foreach-callback nil (tree-model tree-path tree-iter))
f4175703 547
56ccd5b7 548(defbinding %tree-selection-selected-foreach (tree-selection callback-id) nil
f4175703 549 (tree-selection tree-selection)
56ccd5b7 550 (%tree-selection-foreach-callback callback)
f4175703 551 (callback-id unsigned-int))
552
553(defun tree-selection-selected-foreach (selection function)
554 (with-callback-function (id function)
555 (%tree-selection-selected-foreach selection id)))
556
557(defbinding tree-selection-get-selected-rows () (glist tree-path)
558 (tree-selection tree-selection)
559 (nil null))
560
561(defbinding tree-selection-count-selected-rows () int
562 (tree-selection tree-selection))
563
564(defbinding %tree-selection-select-path () nil
565 (tree-selection tree-selection)
566 (tree-path tree-path))
567
568(defbinding %tree-selection-unselect-path () nil
569 (tree-selection tree-selection)
570 (tree-path tree-path))
571
572(defbinding %tree-selection-path-is-selected () boolean
573 (tree-selection tree-selection)
574 (tree-path tree-path))
575
576(defbinding %tree-selection-select-iter () nil
577 (tree-selection tree-selection)
6b1c7348 578 (tree-iter tree-iter))
f4175703 579
580(defbinding %tree-selection-unselect-iter () nil
581 (tree-selection tree-selection)
6b1c7348 582 (tree-iter tree-iter))
f4175703 583
584(defbinding %tree-selection-iter-is-selected () boolean
585 (tree-selection tree-selection)
6b1c7348 586 (tree-iter tree-iter))
f4175703 587
588(defun tree-selection-select (selection row)
589 (etypecase row
590 (tree-path (%tree-selection-select-path selection row))
591 (tree-iter (%tree-selection-select-iter selection row))))
592
593(defun tree-selection-unselect (selection row)
594 (etypecase row
595 (tree-path (%tree-selection-unselect-path selection row))
596 (tree-iter (%tree-selection-unselect-iter selection row))))
597
598(defun tree-selection-is-selected-p (selection row)
599 (etypecase row
600 (tree-path (%tree-selection-path-is-selected selection row))
601 (tree-iter (%tree-selection-iter-is-selected selection row))))
602
603(defbinding tree-selection-select-all () nil
604 (tree-selection tree-selection))
605
606(defbinding tree-selection-unselect-all () nil
607 (tree-selection tree-selection))
608
609(defbinding tree-selection-select-range () nil
610 (tree-selection tree-selection)
611 (start tree-path)
612 (end tree-path))
613
614(defbinding tree-selection-unselect-range () nil
615 (tree-selection tree-selection)
616 (start tree-path)
617 (end tree-path))
618
619
78a17735 620;;; Tree Sortable
621
622(eval-when (:compile-toplevel :load-toplevel :execute)
623 (define-enum-type sort-column (:default -1) (:unsorted -2))
624 (define-enum-type sort-order (:before -1) (:equal 0) (:after 1)))
625
626
56ccd5b7 627(define-callback-marshal %tree-iter-compare-callback (or int sort-order)
628 (tree-model (a tree-iter) (b tree-iter)))
78a17735 629
630(defbinding tree-sortable-sort-column-changed () nil
631 (sortable tree-sortable))
632
633(defbinding %tree-sortable-get-sort-column-id () boolean
634 (sortable tree-sortable)
635 (column int :out)
636 (order sort-type :out))
637
638(defun tree-sortable-get-sort-column (sortable)
639 (multiple-value-bind (special-p column order)
640 (%tree-sortable-get-sort-column-id sortable)
641 (values
642 (if special-p
643 (int-to-sort-order column)
9f321c75 644 (tree-model-column-name sortable column))
78a17735 645 order)))
646
647(defbinding (tree-sortable-set-sort-column
648 "gtk_tree_sortable_set_sort_column_id")
649 (sortable column order) nil
650 (sortable tree-sortable)
651 ((etypecase column
652 ((or integer sort-column) column)
030b4286 653 (symbol (tree-model-column-index sortable column)))
78a17735 654 (or sort-column int))
655 (order sort-type))
656
657(defbinding %tree-sortable-set-sort-func (sortable column function) nil
658 (sortable tree-sortable)
030b4286 659 ((tree-model-column-index sortable column) int)
56ccd5b7 660 (%tree-iter-compare-callback callback)
78a17735 661 ((register-callback-function function) unsigned-int)
56ccd5b7 662 (user-data-destroy-callback callback))
78a17735 663
664(defbinding %tree-sortable-set-default-sort-func () nil
665 (sortable tree-sortable)
56ccd5b7 666 (compare-func (or null callback))
78a17735 667 (callback-id unsigned-int)
56ccd5b7 668 (destroy-func (or null callback)))
78a17735 669
670(defun tree-sortable-set-sort-func (sortable column function)
671 "Sets the comparison function used when sorting to be FUNCTION. If
672the current sort column of SORTABLE is the same as COLUMN,
673then the model will sort using this function."
674 (cond
675 ((and (eq column :default) (not function))
676 (%tree-sortable-set-default-sort-func sortable nil 0 nil))
677 ((eq column :default)
678 (%tree-sortable-set-default-sort-func sortable
56ccd5b7 679 %tree-iter-compare-callback
78a17735 680 (register-callback-function function)
56ccd5b7 681 user-data-destroy-callback))
78a17735 682 ((%tree-sortable-set-sort-func sortable column function))))
683
684(defbinding tree-sortable-has-default-sort-func-p () boolean
685 (sortable tree-sortable))
686
f4175703 687
167450a3 688;;; Tree Store
689
690(defbinding %tree-store-set-column-types () nil
691 (tree-store tree-store)
2a8752b0 692 ((length columns) unsigned-int)
693 (columns (vector gtype)))
167450a3 694
2a8752b0 695(defmethod initialize-instance ((tree-store tree-store) &key column-types
696 column-names)
167450a3 697 (call-next-method)
2a8752b0 698 (%tree-store-set-column-types tree-store column-types)
699 (when column-names
b6d4ac86 700 (setf (user-data tree-store 'column-names) column-names)))
167450a3 701
030b4286 702
703(defbinding %tree-store-set-value () nil
704 (tree-store tree-store)
705 (tree-iter tree-iter)
706 (column int)
707 (gvalue gvalue))
708
709(defmethod (setf tree-model-value) (value (store tree-store) row column)
710 (let* ((index (tree-model-column-index store column))
711 (type (tree-model-get-column-type store index)))
712 (with-gvalue (gvalue type value)
713 (%tree-store-set-value store (ensure-tree-iter store row) index gvalue)))
714 value)
715
167450a3 716
717(defbinding tree-store-remove () boolean
718 (tree-store tree-store)
719 (tree-iter tree-iter))
720
2a8752b0 721(defbinding %tree-store-insert () nil
167450a3 722 (tree-store tree-store)
2a8752b0 723 (tree-iter tree-iter)
167450a3 724 (parent (or null tree-iter))
725 (position int))
726
2a8752b0 727(defun tree-store-insert
728 (store parent position &optional data (iter (make-instance 'tree-iter)))
729 (%tree-store-insert store iter parent position)
030b4286 730 (when data (setf (tree-model-row-data store iter) data))
2a8752b0 731 iter)
732
733(defbinding %tree-store-insert-before () nil
167450a3 734 (tree-store tree-store)
2a8752b0 735 (tree-iter tree-iter)
167450a3 736 (parent (or null tree-iter))
737 (sibling (or null tree-iter)))
738
73572c12 739(defun tree-store-insert-before
2a8752b0 740 (store parent sibling &optional data (iter (make-instance 'tree-iter)))
741 (%tree-store-insert-before store iter parent sibling)
030b4286 742 (when data (setf (tree-model-row-data store iter) data))
2a8752b0 743 iter)
744
745(defbinding %tree-store-insert-after () nil
167450a3 746 (tree-store tree-store)
2a8752b0 747 (tree-iter tree-iter)
167450a3 748 (parent (or null tree-iter))
749 (sibling (or null tree-iter)))
750
2a8752b0 751(defun tree-store-insert-after
752 (store parent sibling &optional data (iter (make-instance 'tree-iter)))
753 (%tree-store-insert-after store iter parent sibling)
030b4286 754 (when data (setf (tree-model-row-data store iter) data))
2a8752b0 755 iter)
756
757(defbinding %tree-store-prepend () nil
167450a3 758 (tree-store tree-store)
2a8752b0 759 (tree-iter tree-iter)
167450a3 760 (parent (or null tree-iter)))
761
2a8752b0 762(defun tree-store-prepend
763 (store parent &optional data (iter (make-instance 'tree-iter)))
764 (%tree-store-prepend store iter parent)
030b4286 765 (when data (setf (tree-model-row-data store iter) data))
2a8752b0 766 iter)
767
768(defbinding %tree-store-append () nil
167450a3 769 (tree-store tree-store)
2a8752b0 770 (tree-iter tree-iter)
167450a3 771 (parent (or null tree-iter)))
772
2a8752b0 773(defun tree-store-append
774 (store parent &optional data (iter (make-instance 'tree-iter)))
775 (%tree-store-append store iter parent)
030b4286 776 (when data (setf (tree-model-row-data store iter) data))
2a8752b0 777 iter)
778
167450a3 779(defbinding (tree-store-is-ancestor-p "gtk_tree_store_is_ancestor") () boolean
780 (tree-store tree-store)
781 (tree-iter tree-iter)
782 (descendant tree-iter))
783
784(defbinding tree-store-iter-depth () int
785 (tree-store tree-store)
786 (tree-iter tree-iter))
787
788(defbinding tree-store-clear () nil
789 (tree-store tree-store))
790
791(defbinding tree-store-reorder () nil
792 (tree-store tree-store)
793 (parent tree-iter)
794 (new-order (vector int)))
795
796(defbinding tree-store-swap () nil
797 (tree-store tree-store)
798 (a tree-iter)
799 (b tree-iter))
800
801(defbinding tree-store-move-before () nil
802 (tree-store tree-store)
803 (iter tree-iter)
804 (psoition (or null tree-iter)))
805
806
807(defbinding tree-store-move-after () nil
808 (tree-store tree-store)
809 (iter tree-iter)
810 (psoition tree-iter))
811
812
813
814;;; Tree View
815
f4175703 816(defmethod initialize-instance ((tree-view tree-view) &rest initargs
817 &key column)
75689fea 818 (declare (ignore column))
2a8752b0 819 (call-next-method)
820 (mapc #'(lambda (column)
821 (tree-view-append-column tree-view column))
822 (get-all initargs :column)))
823
824
167450a3 825(defbinding tree-view-columns-autosize () nil
826 (tree-view tree-view))
827
828(defbinding tree-view-append-column () int
829 (tree-view tree-view)
830 (tree-view-column tree-view-column))
831
832(defbinding tree-view-remove-column () int
833 (tree-view tree-view)
834 (tree-view-column tree-view-column))
835
73572c12 836(defbinding tree-view-insert-column (view column position) int
167450a3 837 (view tree-view)
838 (column tree-view-column)
839 ((if (eq position :end) -1 position) int))
840
841(defbinding tree-view-get-column () tree-view-column
842 (tree-view tree-view)
843 (position int))
844
845(defbinding tree-view-move-column-after () nil
846 (tree-view tree-view)
847 (column tree-view-column)
848 (base-column (or null tree-view-column)))
849
d53cf0ec 850(define-callback-setter tree-view-set-column-drag-function tree-view boolean
851 (column tree-view-column)
852 (prev tree-view-column)
853 (next tree-view-column))
167450a3 854
855(defbinding tree-view-scroll-to-point () nil
856 (tree-view tree-view)
857 (tree-x int)
858 (tree-y int))
859
860(defbinding tree-view-scroll-to-cell () nil
861 (tree-view tree-view)
862 (path (or null tree-path))
863 (column (or null tree-view-column))
864 (use-align boolean)
865 (row-align single-float)
866 (col-align single-float))
867
d53cf0ec 868(defbinding (tree-view-set-cursor "gtk_tree_view_set_cursor_on_cell")
869 (tree-view path &key focus-column focus-cell start-editing) nil
167450a3 870 (tree-view tree-view)
871 (path tree-path)
872 (focus-column (or null tree-view-column))
873 (focus-cell (or null cell-renderer))
874 (start-editing boolean))
875
876(defbinding tree-view-get-cursor () nil
877 (tree-view tree-view)
878 (path tree-path :out )
879 (focus-column tree-view-column :out))
880
881(defbinding tree-view-row-activated () nil
882 (tree-view tree-view)
883 (path tree-path )
884 (column tree-view-column))
885
886(defbinding tree-view-expand-all () nil
887 (tree-view tree-view))
888
889(defbinding tree-view-collapse-all () nil
890 (tree-view tree-view))
891
892(defbinding tree-view-expand-to-path () nil
893 (tree-view tree-view)
894 (path tree-path))
895
896(defbinding tree-view-expand-row () nil
897 (tree-view tree-view)
898 (path tree-path)
899 (open-all boolean))
900
901(defbinding tree-view-collapse-row () nil
902 (tree-view tree-view)
903 (path tree-path))
904
56ccd5b7 905(define-callback-marshal %tree-view-mapping-callback nil (tree-view tree-path))
167450a3 906
56ccd5b7 907(defbinding %tree-view-map-expanded-rows (tree-view callback-id) nil
167450a3 908 (tree-view tree-view)
56ccd5b7 909 (%tree-view-mapping-callback callback)
167450a3 910 (callback-id unsigned-int))
911
912(defun map-expanded-rows (function tree-view)
913 (with-callback-function (id function)
914 (%tree-view-map-expanded-rows tree-view id)))
915
916(defbinding (tree-view-row-expanded-p "gtk_tree_view_row_expanded") () boolean
917 (tree-view tree-view)
918 (path tree-path))
919
920(defbinding tree-view-get-path-at-pos
921 (tree-view x y &optional (cell-x 0) (cell-y 0)) boolean
922 (tree-view tree-view)
923 (x int)
924 (y int)
925 (path tree-path :out)
926 (column tree-view-column :out)
927 (cell-x int)
928 (cell-y int))
929
930(defbinding tree-view-get-cell-area () nil
931 (tree-view tree-view)
932 (path (or null tree-path))
933 (column (or null tree-view-column))
b6d4ac86 934 ((make-instance 'gdk:rectangle) gdk:rectangle :in/return))
167450a3 935
936(defbinding tree-view-get-background-area () nil
937 (tree-view tree-view)
938 (path (or null tree-path))
939 (column (or null tree-view-column))
b6d4ac86 940 ((make-instance 'gdk:rectangle) gdk:rectangle :in/return))
167450a3 941
942(defbinding tree-view-get-visible-rect () nil
943 (tree-view tree-view)
b6d4ac86 944 ((make-instance 'gdk:rectangle) gdk:rectangle :in/return))
167450a3 945
946;; and many more functions which we'll add later
947
2a8752b0 948
78a17735 949;;;; Icon View
950
b6d4ac86 951#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
78a17735 952(progn
953 (defbinding icon-view-get-path-at-pos () tree-path
954 (icon-view icon-view)
955 (x int) (y int))
2a8752b0 956
56ccd5b7 957 (define-callback-marshal %icon-view-foreach-callback nil (icon-view tree-path))
78a17735 958
56ccd5b7 959 (defbinding %icon-view-selected-foreach (icon-view callback-id) tree-path
78a17735 960 (icon-view icon-view)
56ccd5b7 961 (%icon-view-foreach-callback callback)
78a17735 962 (callback-id unsigned-int))
963
964 (defun icon-view-foreach (icon-view function)
965 (with-callback-function (id function)
966 (%icon-view-selected-foreach icon-view id)))
967
968 (defbinding icon-view-select-path () nil
969 (icon-view icon-view)
970 (path tree-path))
971
972 (defbinding icon-view-unselect-path () nil
973 (icon-view icon-view)
974 (path tree-path))
975
976 (defbinding icon-view-path-is-selected-p () boolean
977 (icon-view icon-view)
978 (path tree-path))
979
980 (defbinding icon-view-get-selected-items () (glist tree-path)
981 (icon-view icon-view))
982
983 (defbinding icon-view-select-all () nil
984 (icon-view icon-view))
985
986 (defbinding icon-view-unselect-all () nil
987 (icon-view icon-view))
988
989 (defbinding icon-view-item-activated () nil
990 (icon-view icon-view)
991 (path tree-path))
992
993 (defbinding %icon-view-set-text-column (column icon-view) nil
994 (icon-view icon-view)
995 ((if (integerp column)
996 column
030b4286 997 (tree-model-column-index (icon-view-model icon-view) column)) int))
78a17735 998
c46ca281 999 (defbinding %%icon-view-get-text-column () int
1000 (icon-view icon-view))
1001
1002 (defun %icon-view-get-text-column (icon-view)
030b4286 1003 (tree-model-column-index
c46ca281 1004 (icon-view-model icon-view)
1005 (%%icon-view-get-text-column icon-view)))
1006
1007 (defun %icon-view-text-column-boundp (icon-view)
1008 (not (eql (%%icon-view-get-text-column icon-view) -1)))
1009
1010
78a17735 1011 (defbinding %icon-view-set-markup-column (column icon-view) nil
1012 (icon-view icon-view)
1013 ((if (integerp column)
1014 column
030b4286 1015 (tree-model-column-index (icon-view-model icon-view) column)) int))
78a17735 1016
c46ca281 1017 (defbinding %%icon-view-get-markup-column () int
1018 (icon-view icon-view))
1019
1020 (defun %icon-view-get-markup-column (icon-view)
030b4286 1021 (tree-model-column-index
c46ca281 1022 (icon-view-model icon-view)
1023 (%%icon-view-get-markup-column icon-view)))
1024
1025 (defun %icon-view-markup-column-boundp (icon-view)
1026 (not (eql (%%icon-view-get-markup-column icon-view) -1)))
1027
1028
78a17735 1029 (defbinding %icon-view-set-pixbuf-column (column icon-view) nil
1030 (icon-view icon-view)
1031 ((if (integerp column)
1032 column
030b4286 1033 (tree-model-column-index (icon-view-model icon-view) column)) int)))
bdc0e300 1034
c46ca281 1035 (defbinding %%icon-view-get-pixbuf-column () int
1036 (icon-view icon-view))
1037
1038 (defun %icon-view-get-pixbuf-column (icon-view)
030b4286 1039 (tree-model-column-index
c46ca281 1040 (icon-view-model icon-view)
1041 (%%icon-view-get-pixbuf-column icon-view)))
1042
1043 (defun %icon-view-pixbuf-column-boundp (icon-view)
1044 (not (eql (%%icon-view-get-pixbuf-column icon-view) -1)))
1045
1046
b6d4ac86 1047#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.8.0")
bdc0e300 1048(progn
1049 (defbinding icon-view-get-item-at-pos () boolean
1050 (icon-view icon-view)
1051 (x int)
1052 (y int)
1053 (tree-path tree-path :out)
1054 (cell cell-renderer :out))
1055
1056 (defbinding icon-view-set-cursor (icon-view path &key cell start-editing) nil
1057 (icon-view icon-view)
1058 (path tree-path)
1059 (cell (or null cell-renderer))
1060 (start-editing boolean))
1061
1062 (defbinding icon-view-get-cursor () boolean
1063 (icon-view icon-view)
1064 (path tree-path :out)
1065 (cell cell-renderer :out))
1066
1067 (defbinding icon-view-get-dest-item-at-pos () boolean
1068 (icon-view icon-view)
1069 (drag-x int)
1070 (drag-y int)
1071 (tree-path tree-path :out)
1072 (pos drop-position :out))
1073
1074 (defbinding icon-view-create-drag-icon () gdk:pixmap
1075 (icon-view icon-view)
1076 (tree-path tree-path))
1077
1078 (defbinding icon-view-scroll-to-path (icon-view tree-path &key row-align column-align) nil
1079 (icon-view icon-view)
1080 (tree-path tree-path)
1081 ((or row-align column-align) boolean)
1082 (row-align single-float)
1083 (column-align single-float))
1084
1085 (defbinding icon-view-get-visible-range () boolean
1086 (icon-view icon-view)
1087 (start-path tree-path :out)
1088 (end-path tree-path :out))
1089
d53cf0ec 1090 (defbinding icon-view-enable-model-drag-source () nil
1091 (icon-view icon-view)
1092 (start-button-mask gdk:modifier-type)
1093 (targets (vector (inlined target-entry)))
1094 ((length targets) unsigned-int)
1095 (actions gdk:drag-action))
1096
1097 (defbinding icon-view-enable-model-drag-dest () nil
1098 (icon-view icon-view)
1099 (targets (vector (inlined target-entry)))
1100 ((length targets) unsigned-int)
1101 (actions gdk:drag-action))
bdc0e300 1102
1103 (defbinding icon-view-unset-model-drag-source () nil
1104 (icon-view icon-view))
1105
1106 (defbinding icon-view-unset-model-drag-dest () nil
1107 (icon-view icon-view)))