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 | |
cc9d465b |
23 | ;; $Id: gtktree.lisp,v 1.18 2006-03-03 19:00:12 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 | |
76 | |
77 | ;;;; List Store |
78 | |
2a8752b0 |
79 | (defmethod initialize-instance ((list-store list-store) &key column-types |
80 | column-names initial-content) |
167450a3 |
81 | (call-next-method) |
2a8752b0 |
82 | (%list-store-set-column-types list-store column-types) |
83 | (when column-names |
cc9d465b |
84 | (setf |
85 | (object-data list-store 'column-names) |
86 | (coerce column-names 'vector))) |
2a8752b0 |
87 | (when initial-content |
88 | (loop |
89 | with iter = (make-instance 'tree-iter) |
90 | for row in initial-content |
91 | do (list-store-append list-store row iter)))) |
167450a3 |
92 | |
5f0ccd62 |
93 | (defgeneric column-setter-name (store)) |
167450a3 |
94 | |
2a8752b0 |
95 | (defmethod column-setter-name ((list-store list-store)) |
96 | (declare (ignore list-store)) |
97 | "gtk_list_store_set") |
167450a3 |
98 | |
2a8752b0 |
99 | (defbinding %list-store-set-column-types () nil |
167450a3 |
100 | (list-store list-store) |
2a8752b0 |
101 | ((length columns) unsigned-int) |
102 | (columns (vector gtype))) |
167450a3 |
103 | |
f4175703 |
104 | (defbinding %list-store-remove () boolean |
167450a3 |
105 | (list-store list-store) |
106 | (tree-iter tree-iter)) |
107 | |
f4175703 |
108 | (defun list-store-remove (store row) |
109 | (etypecase row |
110 | (tree-iter |
111 | (%list-store-remove store row)) |
112 | (tree-path |
113 | (multiple-value-bind (valid iter) (tree-model-get-iter store row) |
114 | (if valid |
115 | (%list-store-remove store iter) |
78a17735 |
116 | (error "~A not poiniting to a valid iterator in ~A" row store)))) |
f4175703 |
117 | (tree-row-reference |
118 | (let ((path (tree-row-reference-get-path row))) |
119 | (if path |
120 | (list-store-remove store path) |
121 | (error "~A not valid" row)))))) |
122 | |
123 | |
2a8752b0 |
124 | (defbinding %list-store-insert () nil |
167450a3 |
125 | (list-store list-store) |
2a8752b0 |
126 | (tree-iter tree-iter) |
167450a3 |
127 | (position int)) |
128 | |
2a8752b0 |
129 | (defun list-store-insert |
130 | (store position &optional data (iter (make-instance 'tree-iter))) |
131 | (%list-store-insert store iter position) |
132 | (when data (%tree-model-set store iter data)) |
133 | iter) |
134 | |
135 | (defbinding %list-store-insert-before () nil |
167450a3 |
136 | (list-store list-store) |
2a8752b0 |
137 | (tree-iter tree-iter) |
167450a3 |
138 | (sibling (or null tree-iter))) |
139 | |
2a8752b0 |
140 | (defun list-store-insert-before |
141 | (store sibling &optional data (iter (make-instance 'tree-iter))) |
142 | (%list-store-insert-before store iter sibling) |
143 | (when data (%tree-model-set store iter data)) |
144 | iter) |
145 | |
146 | (defbinding %list-store-insert-after |
147 | (list-store &optional sibling (tree-iter (make-instance 'tree-iter))) nil |
167450a3 |
148 | (list-store list-store) |
2a8752b0 |
149 | (tree-iter tree-iter) |
167450a3 |
150 | (sibling (or null tree-iter))) |
151 | |
2a8752b0 |
152 | (defun list-store-insert-after |
153 | (store sibling &optional data (iter (make-instance 'tree-iter))) |
154 | (%list-store-insert-after store iter sibling) |
155 | (when data (%tree-model-set store iter data)) |
156 | iter) |
157 | |
158 | (defbinding %list-store-prepend () nil |
167450a3 |
159 | (list-store list-store) |
2a8752b0 |
160 | (tree-iter tree-iter)) |
161 | |
162 | (defun list-store-prepend |
163 | (store &optional data (iter (make-instance 'tree-iter))) |
164 | (%list-store-prepend store iter) |
165 | (when data (%tree-model-set store iter data)) |
166 | iter) |
167450a3 |
167 | |
2a8752b0 |
168 | (defbinding %list-store-append () nil |
167450a3 |
169 | (list-store list-store) |
2a8752b0 |
170 | (tree-iter tree-iter)) |
171 | |
172 | (defun list-store-append |
173 | (store &optional data (iter (make-instance 'tree-iter))) |
174 | (%list-store-append store iter) |
175 | (when data (%tree-model-set store iter data)) |
176 | iter) |
167450a3 |
177 | |
178 | (defbinding list-store-clear () nil |
179 | (list-store list-store)) |
180 | |
181 | (defbinding list-store-reorder () nil |
182 | (list-store list-store) |
183 | (new-order (vector int))) |
184 | |
185 | (defbinding list-store-swap () nil |
186 | (list-store list-store) |
187 | (a tree-iter) |
188 | (b tree-iter)) |
189 | |
190 | (defbinding list-store-move-before () nil |
191 | (list-store list-store) |
192 | (iter tree-iter) |
193 | (psoition (or null tree-iter))) |
194 | |
167450a3 |
195 | (defbinding list-store-move-after () nil |
196 | (list-store list-store) |
197 | (iter tree-iter) |
198 | (psoition tree-iter)) |
199 | |
200 | |
201 | ;;; Tree Model |
202 | |
2a8752b0 |
203 | (defbinding %tree-path-free () nil |
204 | (location pointer)) |
205 | |
206 | (defbinding %tree-path-get-indices () pointer |
207 | (location pointer)) |
208 | |
209 | (defbinding %tree-path-get-depth () int |
210 | (location pointer)) |
211 | |
212 | (defun %make-tree-path (path) |
213 | (let ((c-vector (make-c-vector 'int (length path) path)) |
214 | (location (allocate-memory (+ (size-of 'int) (size-of 'pointer))))) |
215 | (funcall (writer-function 'int) (length path) location) |
216 | (funcall (writer-function 'pointer) c-vector location (size-of 'int)) |
217 | location)) |
218 | |
f4175703 |
219 | (defun %tree-path-to-vector (location) |
220 | (let ((indices (%tree-path-get-indices location)) |
221 | (depth (%tree-path-get-depth location))) |
222 | (if (null-pointer-p indices) |
223 | #() |
224 | (map-c-vector 'vector #'identity indices 'int depth)))) |
2a8752b0 |
225 | |
226 | (eval-when (:compile-toplevel :load-toplevel :execute) |
75689fea |
227 | (define-type-method alien-type ((type tree-path)) |
228 | (declare (ignore type)) |
2a8752b0 |
229 | (alien-type 'pointer)) |
230 | |
75689fea |
231 | (define-type-method size-of ((type tree-path)) |
232 | (declare (ignore type)) |
2a8752b0 |
233 | (size-of 'pointer)) |
234 | |
75689fea |
235 | (define-type-method to-alien-form ((type tree-path) path) |
236 | (declare (ignore type)) |
2a8752b0 |
237 | `(%make-tree-path ,path)) |
238 | |
75689fea |
239 | (define-type-method from-alien-form ((type tree-path) location) |
240 | (declare (ignore type)) |
f4175703 |
241 | `(let ((location ,location)) |
242 | (prog1 |
243 | (%tree-path-to-vector location) |
244 | (%tree-path-free location)))) |
2a8752b0 |
245 | |
75689fea |
246 | (define-type-method copy-from-alien-form ((type tree-path) location) |
247 | (declare (ignore type)) |
f4175703 |
248 | `(%tree-path-to-vector ,location)) |
2a8752b0 |
249 | |
75689fea |
250 | (define-type-method cleanup-form ((type tree-path) location) |
251 | (declare (ignore type)) |
f4175703 |
252 | `(%tree-path-free ,location))) |
253 | |
75689fea |
254 | (define-type-method to-alien-function ((type tree-path)) |
255 | (declare (ignore type)) |
f4175703 |
256 | #'%make-tree-path) |
2a8752b0 |
257 | |
75689fea |
258 | (define-type-method from-alien-function ((type tree-path)) |
259 | (declare (ignore type)) |
f4175703 |
260 | #'(lambda (location) |
261 | (prog1 |
262 | (%tree-path-to-vector location) |
263 | (%tree-path-free location)))) |
264 | |
75689fea |
265 | (define-type-method copy-from-alien-function ((type tree-path)) |
266 | (declare (ignore type )) |
f4175703 |
267 | #'%tree-path-to-vector) |
268 | |
75689fea |
269 | (define-type-method cleanup-function ((type tree-path)) |
270 | (declare (ignore type)) |
f4175703 |
271 | #'%tree-path-free) |
272 | |
75689fea |
273 | (define-type-method writer-function ((type tree-path)) |
274 | (declare (ignore type)) |
f4175703 |
275 | (let ((writer (writer-function 'pointer))) |
276 | #'(lambda (path location &optional (offset 0)) |
277 | (funcall writer (%make-tree-path path) location offset)))) |
278 | |
75689fea |
279 | (define-type-method reader-function ((type tree-path)) |
280 | (declare (ignore type)) |
f4175703 |
281 | (let ((reader (reader-function 'pointer))) |
9e6c0587 |
282 | #'(lambda (location &optional (offset 0) weak-p) |
283 | (declare (ignore weak-p)) |
f4175703 |
284 | (%tree-path-to-vector (funcall reader location offset))))) |
2a8752b0 |
285 | |
75689fea |
286 | (define-type-method destroy-function ((type tree-path)) |
287 | (declare (ignore type)) |
f433f8a7 |
288 | (let ((reader (reader-function 'pointer))) |
289 | #'(lambda (location &optional (offset 0)) |
290 | (%tree-path-free (funcall reader location offset))))) |
291 | |
2a8752b0 |
292 | |
293 | (defbinding %tree-row-reference-new () pointer |
294 | (model tree-model) |
295 | (path tree-path)) |
296 | |
9176d301 |
297 | (defmethod allocate-foreign ((reference tree-row-reference) &key model path) |
298 | (%tree-row-reference-new model path)) |
2a8752b0 |
299 | |
300 | (defbinding tree-row-reference-get-path () tree-path |
301 | (reference tree-row-reference)) |
302 | |
303 | (defbinding (tree-row-reference-valid-p "gtk_tree_row_reference_valid") () boolean |
304 | (reference tree-row-reference)) |
305 | |
306 | |
18e45ba6 |
307 | (defbinding tree-model-get-column-type () gtype ;type-number |
2a8752b0 |
308 | (tree-model tree-model) |
309 | (index int)) |
310 | |
311 | (defbinding tree-model-get-iter |
312 | (model path &optional (iter (make-instance 'tree-iter))) boolean |
313 | (model tree-model) |
314 | (iter tree-iter :return) |
315 | (path tree-path)) |
316 | |
317 | (defbinding tree-model-get-path () tree-path |
318 | (tree-model tree-model) |
319 | (iter tree-iter)) |
320 | |
321 | (defbinding %tree-model-get-value () nil |
322 | (tree-model tree-model) |
323 | (iter tree-iter) |
324 | (column int) |
325 | (gvalue gvalue)) |
326 | |
cc9d465b |
327 | (defgeneric tree-model-value (model row column)) |
328 | |
329 | (defmethod tree-model-value ((model tree-model) row column) |
78a17735 |
330 | (let ((index (column-index model column)) |
331 | (iter (etypecase row |
332 | (tree-iter row) |
333 | (tree-path (multiple-value-bind (valid iter) |
334 | (tree-model-get-iter model row) |
335 | (if valid |
336 | iter |
337 | (error "Invalid tree path: ~A" row))))))) |
0d46865d |
338 | (with-gvalue (gvalue) |
2a8752b0 |
339 | (%tree-model-get-value model iter index gvalue)))) |
340 | |
341 | (defbinding tree-model-iter-next () boolean |
342 | (tree-model tree-model) |
343 | (iter tree-iter :return)) |
344 | |
345 | (defbinding tree-model-iter-children |
346 | (tree-model parent &optional (iter (make-instance 'tree-iter))) boolean |
347 | (tree-model tree-model) |
348 | (iter tree-iter :return) |
349 | (parent (or null tree-iter))) |
350 | |
351 | (defbinding (tree-model-iter-has-child-p "gtk_tree_model_iter_has_child") |
352 | () boolean |
353 | (tree-model tree-model) |
354 | (iter tree-iter)) |
355 | |
356 | (defbinding tree-model-iter-n-children () int |
357 | (tree-model tree-model) |
358 | (iter tree-iter)) |
359 | |
360 | (defbinding tree-model-iter-nth-child |
73572c12 |
361 | (tree-model parent n &optional (iter (make-instance 'tree-iter))) boolean |
2a8752b0 |
362 | (tree-model tree-model) |
363 | (iter tree-iter :return) |
364 | (parent (or null tree-iter)) |
365 | (n int)) |
366 | |
367 | (defbinding tree-model-iter-parent |
368 | (tree-model child &optional (iter (make-instance 'tree-iter))) boolean |
369 | (tree-model tree-model) |
370 | (iter tree-iter :return) |
371 | (child tree-iter)) |
372 | |
56ccd5b7 |
373 | (define-callback-marshal %tree-model-foreach-callback boolean |
374 | (tree-model tree-path tree-iter)) |
2a8752b0 |
375 | |
56ccd5b7 |
376 | (defbinding %tree-model-foreach (tree-model callback-id) nil |
2a8752b0 |
377 | (tree-model tree-model) |
56ccd5b7 |
378 | (%tree-model-foreach-callback callback) |
2a8752b0 |
379 | (callback-id unsigned-int)) |
380 | |
381 | (defun tree-model-foreach (model function) |
382 | (with-callback-function (id function) |
383 | (%tree-model-foreach model id))) |
384 | |
385 | (defbinding tree-model-row-changed () nil |
386 | (tree-model tree-model) |
387 | (path tree-path) |
388 | (iter tree-iter)) |
389 | |
390 | (defbinding tree-model-row-inserted () nil |
391 | (tree-model tree-model) |
392 | (path tree-path) |
393 | (iter tree-iter)) |
394 | |
395 | (defbinding tree-model-row-has-child-toggled () nil |
396 | (tree-model tree-model) |
397 | (path tree-path) |
398 | (iter tree-iter)) |
399 | |
400 | (defbinding tree-model-row-deleted () nil |
401 | (tree-model tree-model) |
402 | (path tree-path) |
403 | (iter tree-iter)) |
404 | |
405 | (defbinding tree-model-rows-reordered () nil |
406 | (tree-model tree-model) |
407 | (path tree-path) |
408 | (iter tree-iter) |
409 | (new-order int)) |
410 | |
411 | |
412 | (defun column-types (model columns) |
75689fea |
413 | (declare (ignore model)) |
2a8752b0 |
414 | (map 'vector |
415 | #'(lambda (column) |
416 | (find-type-number (first (mklist column)))) |
417 | columns)) |
418 | |
419 | (defun column-index (model column) |
420 | (or |
421 | (etypecase column |
422 | (number column) |
423 | (symbol (position column (object-data model 'column-names))) |
424 | (string (position column (object-data model 'column-names) |
425 | :test #'string=))) |
426 | (error "~A has no column ~S" model column))) |
427 | |
78a17735 |
428 | (defun column-name (model index) |
429 | (svref (object-data model 'column-names) index)) |
430 | |
2a8752b0 |
431 | (defun tree-model-column-value-setter (model column) |
432 | (let ((setters (or |
433 | (object-data model 'column-setters) |
434 | (setf |
435 | (object-data model 'column-setters) |
436 | (make-array (tree-model-n-columns model) |
437 | :initial-element nil))))) |
438 | (let ((index (column-index model column))) |
439 | (or |
440 | (svref setters index) |
441 | (setf |
442 | (svref setters index) |
443 | (let ((setter |
444 | (mkbinding (column-setter-name model) |
445 | nil (type-of model) 'tree-iter 'int |
18e45ba6 |
446 | ; (type-from-number (tree-model-get-column-type model index)) |
447 | (tree-model-get-column-type model index) |
2a8752b0 |
448 | 'int))) |
449 | #'(lambda (value iter) |
450 | (funcall setter model iter index value -1)))))))) |
451 | |
452 | (defun tree-model-row-setter (model) |
453 | (or |
454 | (object-data model 'row-setter) |
455 | (progn |
456 | ;; This will create any missing column setter |
457 | (loop |
458 | for i from 0 below (tree-model-n-columns model) |
459 | do (tree-model-column-value-setter model i)) |
460 | (let ((setters (object-data model 'column-setters))) |
461 | (setf |
462 | (object-data model 'row-setter) |
463 | #'(lambda (row iter) |
464 | (map nil #'(lambda (value setter) |
465 | (funcall setter value iter)) |
466 | row setters))))))) |
467 | |
cc9d465b |
468 | (defgeneric (setf tree-model-value) (value model row column)) |
469 | |
470 | (defmethod (setf tree-model-value) (value (model tree-model) row column) |
78a17735 |
471 | (let ((iter (etypecase row |
472 | (tree-iter row) |
473 | (tree-path (multiple-value-bind (valid iter) |
474 | (tree-model-get-iter model row) |
475 | (if valid |
476 | iter |
477 | (error "Invalid tree path: ~A" row))))))) |
478 | (funcall (tree-model-column-value-setter model column) value iter) |
479 | value)) |
2a8752b0 |
480 | |
481 | (defun (setf tree-model-row-data) (data model iter) |
482 | (funcall (tree-model-row-setter model) data iter) |
483 | data) |
484 | |
485 | (defun %tree-model-set (model iter data) |
486 | (etypecase data |
487 | (vector (setf (tree-model-row-data model iter) data)) |
488 | (cons |
489 | (loop |
490 | as (column value . rest) = data then rest |
78a17735 |
491 | do (setf (tree-model-value model iter column) value) |
2a8752b0 |
492 | while rest)))) |
167450a3 |
493 | |
494 | |
f4175703 |
495 | ;;; Tree Selection |
496 | |
56ccd5b7 |
497 | (define-callback-marshal %tree-selection-callback boolean |
498 | (tree-selection tree-model tree-path (path-currently-selected boolean))) |
f4175703 |
499 | |
500 | (defbinding tree-selection-set-select-function (selection function) nil |
501 | (selection tree-selection) |
56ccd5b7 |
502 | (%tree-selection-callback callback) |
f4175703 |
503 | ((register-callback-function function) unsigned-int) |
56ccd5b7 |
504 | (user-data-destroy-callback callback)) |
f4175703 |
505 | |
506 | (defbinding tree-selection-get-selected |
507 | (selection &optional (iter (make-instance 'tree-iter))) boolean |
508 | (selection tree-selection) |
509 | (nil null) |
510 | (iter tree-iter :return)) |
511 | |
56ccd5b7 |
512 | (define-callback-marshal %tree-selection-foreach-callback nil (tree-model tree-path tree-iter)) |
f4175703 |
513 | |
56ccd5b7 |
514 | (defbinding %tree-selection-selected-foreach (tree-selection callback-id) nil |
f4175703 |
515 | (tree-selection tree-selection) |
56ccd5b7 |
516 | (%tree-selection-foreach-callback callback) |
f4175703 |
517 | (callback-id unsigned-int)) |
518 | |
519 | (defun tree-selection-selected-foreach (selection function) |
520 | (with-callback-function (id function) |
521 | (%tree-selection-selected-foreach selection id))) |
522 | |
523 | (defbinding tree-selection-get-selected-rows () (glist tree-path) |
524 | (tree-selection tree-selection) |
525 | (nil null)) |
526 | |
527 | (defbinding tree-selection-count-selected-rows () int |
528 | (tree-selection tree-selection)) |
529 | |
530 | (defbinding %tree-selection-select-path () nil |
531 | (tree-selection tree-selection) |
532 | (tree-path tree-path)) |
533 | |
534 | (defbinding %tree-selection-unselect-path () nil |
535 | (tree-selection tree-selection) |
536 | (tree-path tree-path)) |
537 | |
538 | (defbinding %tree-selection-path-is-selected () boolean |
539 | (tree-selection tree-selection) |
540 | (tree-path tree-path)) |
541 | |
542 | (defbinding %tree-selection-select-iter () nil |
543 | (tree-selection tree-selection) |
544 | (tree-path tree-path)) |
545 | |
546 | (defbinding %tree-selection-unselect-iter () nil |
547 | (tree-selection tree-selection) |
548 | (tree-path tree-path)) |
549 | |
550 | (defbinding %tree-selection-iter-is-selected () boolean |
551 | (tree-selection tree-selection) |
552 | (tree-path tree-path)) |
553 | |
554 | (defun tree-selection-select (selection row) |
555 | (etypecase row |
556 | (tree-path (%tree-selection-select-path selection row)) |
557 | (tree-iter (%tree-selection-select-iter selection row)))) |
558 | |
559 | (defun tree-selection-unselect (selection row) |
560 | (etypecase row |
561 | (tree-path (%tree-selection-unselect-path selection row)) |
562 | (tree-iter (%tree-selection-unselect-iter selection row)))) |
563 | |
564 | (defun tree-selection-is-selected-p (selection row) |
565 | (etypecase row |
566 | (tree-path (%tree-selection-path-is-selected selection row)) |
567 | (tree-iter (%tree-selection-iter-is-selected selection row)))) |
568 | |
569 | (defbinding tree-selection-select-all () nil |
570 | (tree-selection tree-selection)) |
571 | |
572 | (defbinding tree-selection-unselect-all () nil |
573 | (tree-selection tree-selection)) |
574 | |
575 | (defbinding tree-selection-select-range () nil |
576 | (tree-selection tree-selection) |
577 | (start tree-path) |
578 | (end tree-path)) |
579 | |
580 | (defbinding tree-selection-unselect-range () nil |
581 | (tree-selection tree-selection) |
582 | (start tree-path) |
583 | (end tree-path)) |
584 | |
585 | |
78a17735 |
586 | ;;; Tree Sortable |
587 | |
588 | (eval-when (:compile-toplevel :load-toplevel :execute) |
589 | (define-enum-type sort-column (:default -1) (:unsorted -2)) |
590 | (define-enum-type sort-order (:before -1) (:equal 0) (:after 1))) |
591 | |
592 | |
56ccd5b7 |
593 | (define-callback-marshal %tree-iter-compare-callback (or int sort-order) |
594 | (tree-model (a tree-iter) (b tree-iter))) |
78a17735 |
595 | |
596 | (defbinding tree-sortable-sort-column-changed () nil |
597 | (sortable tree-sortable)) |
598 | |
599 | (defbinding %tree-sortable-get-sort-column-id () boolean |
600 | (sortable tree-sortable) |
601 | (column int :out) |
602 | (order sort-type :out)) |
603 | |
604 | (defun tree-sortable-get-sort-column (sortable) |
605 | (multiple-value-bind (special-p column order) |
606 | (%tree-sortable-get-sort-column-id sortable) |
607 | (values |
608 | (if special-p |
609 | (int-to-sort-order column) |
610 | (column-name sortable column)) |
611 | order))) |
612 | |
613 | (defbinding (tree-sortable-set-sort-column |
614 | "gtk_tree_sortable_set_sort_column_id") |
615 | (sortable column order) nil |
616 | (sortable tree-sortable) |
617 | ((etypecase column |
618 | ((or integer sort-column) column) |
619 | (symbol (column-index sortable column))) |
620 | (or sort-column int)) |
621 | (order sort-type)) |
622 | |
623 | (defbinding %tree-sortable-set-sort-func (sortable column function) nil |
624 | (sortable tree-sortable) |
625 | ((column-index sortable column) int) |
56ccd5b7 |
626 | (%tree-iter-compare-callback callback) |
78a17735 |
627 | ((register-callback-function function) unsigned-int) |
56ccd5b7 |
628 | (user-data-destroy-callback callback)) |
78a17735 |
629 | |
630 | (defbinding %tree-sortable-set-default-sort-func () nil |
631 | (sortable tree-sortable) |
56ccd5b7 |
632 | (compare-func (or null callback)) |
78a17735 |
633 | (callback-id unsigned-int) |
56ccd5b7 |
634 | (destroy-func (or null callback))) |
78a17735 |
635 | |
636 | (defun tree-sortable-set-sort-func (sortable column function) |
637 | "Sets the comparison function used when sorting to be FUNCTION. If |
638 | the current sort column of SORTABLE is the same as COLUMN, |
639 | then the model will sort using this function." |
640 | (cond |
641 | ((and (eq column :default) (not function)) |
642 | (%tree-sortable-set-default-sort-func sortable nil 0 nil)) |
643 | ((eq column :default) |
644 | (%tree-sortable-set-default-sort-func sortable |
56ccd5b7 |
645 | %tree-iter-compare-callback |
78a17735 |
646 | (register-callback-function function) |
56ccd5b7 |
647 | user-data-destroy-callback)) |
78a17735 |
648 | ((%tree-sortable-set-sort-func sortable column function)))) |
649 | |
650 | (defbinding tree-sortable-has-default-sort-func-p () boolean |
651 | (sortable tree-sortable)) |
652 | |
f4175703 |
653 | |
167450a3 |
654 | ;;; Tree Store |
655 | |
656 | (defbinding %tree-store-set-column-types () nil |
657 | (tree-store tree-store) |
2a8752b0 |
658 | ((length columns) unsigned-int) |
659 | (columns (vector gtype))) |
167450a3 |
660 | |
2a8752b0 |
661 | (defmethod initialize-instance ((tree-store tree-store) &key column-types |
662 | column-names) |
167450a3 |
663 | (call-next-method) |
2a8752b0 |
664 | (%tree-store-set-column-types tree-store column-types) |
665 | (when column-names |
666 | (setf (object-data tree-store 'column-names) column-names))) |
167450a3 |
667 | |
2a8752b0 |
668 | (defmethod column-setter-name ((tree-store tree-store)) |
669 | (declare (ignore tree-store)) |
670 | "gtk_tree_store_set") |
167450a3 |
671 | |
672 | (defbinding tree-store-remove () boolean |
673 | (tree-store tree-store) |
674 | (tree-iter tree-iter)) |
675 | |
2a8752b0 |
676 | (defbinding %tree-store-insert () nil |
167450a3 |
677 | (tree-store tree-store) |
2a8752b0 |
678 | (tree-iter tree-iter) |
167450a3 |
679 | (parent (or null tree-iter)) |
680 | (position int)) |
681 | |
2a8752b0 |
682 | (defun tree-store-insert |
683 | (store parent position &optional data (iter (make-instance 'tree-iter))) |
684 | (%tree-store-insert store iter parent position) |
685 | (when data (%tree-model-set store iter data)) |
686 | iter) |
687 | |
688 | (defbinding %tree-store-insert-before () nil |
167450a3 |
689 | (tree-store tree-store) |
2a8752b0 |
690 | (tree-iter tree-iter) |
167450a3 |
691 | (parent (or null tree-iter)) |
692 | (sibling (or null tree-iter))) |
693 | |
73572c12 |
694 | (defun tree-store-insert-before |
2a8752b0 |
695 | (store parent sibling &optional data (iter (make-instance 'tree-iter))) |
696 | (%tree-store-insert-before store iter parent sibling) |
697 | (when data (%tree-model-set store iter data)) |
698 | iter) |
699 | |
700 | (defbinding %tree-store-insert-after () nil |
167450a3 |
701 | (tree-store tree-store) |
2a8752b0 |
702 | (tree-iter tree-iter) |
167450a3 |
703 | (parent (or null tree-iter)) |
704 | (sibling (or null tree-iter))) |
705 | |
2a8752b0 |
706 | (defun tree-store-insert-after |
707 | (store parent sibling &optional data (iter (make-instance 'tree-iter))) |
708 | (%tree-store-insert-after store iter parent sibling) |
709 | (when data (%tree-model-set store iter data)) |
710 | iter) |
711 | |
712 | (defbinding %tree-store-prepend () nil |
167450a3 |
713 | (tree-store tree-store) |
2a8752b0 |
714 | (tree-iter tree-iter) |
167450a3 |
715 | (parent (or null tree-iter))) |
716 | |
2a8752b0 |
717 | (defun tree-store-prepend |
718 | (store parent &optional data (iter (make-instance 'tree-iter))) |
719 | (%tree-store-prepend store iter parent) |
720 | (when data (%tree-model-set store iter data)) |
721 | iter) |
722 | |
723 | (defbinding %tree-store-append () nil |
167450a3 |
724 | (tree-store tree-store) |
2a8752b0 |
725 | (tree-iter tree-iter) |
167450a3 |
726 | (parent (or null tree-iter))) |
727 | |
2a8752b0 |
728 | (defun tree-store-append |
729 | (store parent &optional data (iter (make-instance 'tree-iter))) |
730 | (%tree-store-append store iter parent) |
731 | (when data (%tree-model-set store iter data)) |
732 | iter) |
733 | |
167450a3 |
734 | (defbinding (tree-store-is-ancestor-p "gtk_tree_store_is_ancestor") () boolean |
735 | (tree-store tree-store) |
736 | (tree-iter tree-iter) |
737 | (descendant tree-iter)) |
738 | |
739 | (defbinding tree-store-iter-depth () int |
740 | (tree-store tree-store) |
741 | (tree-iter tree-iter)) |
742 | |
743 | (defbinding tree-store-clear () nil |
744 | (tree-store tree-store)) |
745 | |
746 | (defbinding tree-store-reorder () nil |
747 | (tree-store tree-store) |
748 | (parent tree-iter) |
749 | (new-order (vector int))) |
750 | |
751 | (defbinding tree-store-swap () nil |
752 | (tree-store tree-store) |
753 | (a tree-iter) |
754 | (b tree-iter)) |
755 | |
756 | (defbinding tree-store-move-before () nil |
757 | (tree-store tree-store) |
758 | (iter tree-iter) |
759 | (psoition (or null tree-iter))) |
760 | |
761 | |
762 | (defbinding tree-store-move-after () nil |
763 | (tree-store tree-store) |
764 | (iter tree-iter) |
765 | (psoition tree-iter)) |
766 | |
767 | |
768 | |
769 | ;;; Tree View |
770 | |
f4175703 |
771 | (defmethod initialize-instance ((tree-view tree-view) &rest initargs |
772 | &key column) |
75689fea |
773 | (declare (ignore column)) |
2a8752b0 |
774 | (call-next-method) |
775 | (mapc #'(lambda (column) |
776 | (tree-view-append-column tree-view column)) |
777 | (get-all initargs :column))) |
778 | |
779 | |
167450a3 |
780 | (defbinding tree-view-columns-autosize () nil |
781 | (tree-view tree-view)) |
782 | |
783 | (defbinding tree-view-append-column () int |
784 | (tree-view tree-view) |
785 | (tree-view-column tree-view-column)) |
786 | |
787 | (defbinding tree-view-remove-column () int |
788 | (tree-view tree-view) |
789 | (tree-view-column tree-view-column)) |
790 | |
73572c12 |
791 | (defbinding tree-view-insert-column (view column position) int |
167450a3 |
792 | (view tree-view) |
793 | (column tree-view-column) |
794 | ((if (eq position :end) -1 position) int)) |
795 | |
796 | (defbinding tree-view-get-column () tree-view-column |
797 | (tree-view tree-view) |
798 | (position int)) |
799 | |
800 | (defbinding tree-view-move-column-after () nil |
801 | (tree-view tree-view) |
802 | (column tree-view-column) |
803 | (base-column (or null tree-view-column))) |
804 | |
805 | ;;(defbinding tree-view-set-column drag-function ...) |
806 | |
807 | (defbinding tree-view-scroll-to-point () nil |
808 | (tree-view tree-view) |
809 | (tree-x int) |
810 | (tree-y int)) |
811 | |
812 | (defbinding tree-view-scroll-to-cell () nil |
813 | (tree-view tree-view) |
814 | (path (or null tree-path)) |
815 | (column (or null tree-view-column)) |
816 | (use-align boolean) |
817 | (row-align single-float) |
818 | (col-align single-float)) |
819 | |
820 | (defbinding tree-view-set-cursor () nil |
821 | (tree-view tree-view) |
822 | (path tree-path) |
823 | (focus-column tree-view-column) |
824 | (start-editing boolean)) |
825 | |
826 | (defbinding tree-view-set-cursor-on-cell () nil |
827 | (tree-view tree-view) |
828 | (path tree-path) |
829 | (focus-column (or null tree-view-column)) |
830 | (focus-cell (or null cell-renderer)) |
831 | (start-editing boolean)) |
832 | |
833 | (defbinding tree-view-get-cursor () nil |
834 | (tree-view tree-view) |
835 | (path tree-path :out ) |
836 | (focus-column tree-view-column :out)) |
837 | |
838 | (defbinding tree-view-row-activated () nil |
839 | (tree-view tree-view) |
840 | (path tree-path ) |
841 | (column tree-view-column)) |
842 | |
843 | (defbinding tree-view-expand-all () nil |
844 | (tree-view tree-view)) |
845 | |
846 | (defbinding tree-view-collapse-all () nil |
847 | (tree-view tree-view)) |
848 | |
849 | (defbinding tree-view-expand-to-path () nil |
850 | (tree-view tree-view) |
851 | (path tree-path)) |
852 | |
853 | (defbinding tree-view-expand-row () nil |
854 | (tree-view tree-view) |
855 | (path tree-path) |
856 | (open-all boolean)) |
857 | |
858 | (defbinding tree-view-collapse-row () nil |
859 | (tree-view tree-view) |
860 | (path tree-path)) |
861 | |
56ccd5b7 |
862 | (define-callback-marshal %tree-view-mapping-callback nil (tree-view tree-path)) |
167450a3 |
863 | |
56ccd5b7 |
864 | (defbinding %tree-view-map-expanded-rows (tree-view callback-id) nil |
167450a3 |
865 | (tree-view tree-view) |
56ccd5b7 |
866 | (%tree-view-mapping-callback callback) |
167450a3 |
867 | (callback-id unsigned-int)) |
868 | |
869 | (defun map-expanded-rows (function tree-view) |
870 | (with-callback-function (id function) |
871 | (%tree-view-map-expanded-rows tree-view id))) |
872 | |
873 | (defbinding (tree-view-row-expanded-p "gtk_tree_view_row_expanded") () boolean |
874 | (tree-view tree-view) |
875 | (path tree-path)) |
876 | |
877 | (defbinding tree-view-get-path-at-pos |
878 | (tree-view x y &optional (cell-x 0) (cell-y 0)) boolean |
879 | (tree-view tree-view) |
880 | (x int) |
881 | (y int) |
882 | (path tree-path :out) |
883 | (column tree-view-column :out) |
884 | (cell-x int) |
885 | (cell-y int)) |
886 | |
887 | (defbinding tree-view-get-cell-area () nil |
888 | (tree-view tree-view) |
889 | (path (or null tree-path)) |
890 | (column (or null tree-view-column)) |
2a8752b0 |
891 | ((make-instance 'gdk:rectangle) gdk:rectangle :return)) |
167450a3 |
892 | |
893 | (defbinding tree-view-get-background-area () nil |
894 | (tree-view tree-view) |
895 | (path (or null tree-path)) |
896 | (column (or null tree-view-column)) |
2a8752b0 |
897 | ((make-instance 'gdk:rectangle) gdk:rectangle :return)) |
167450a3 |
898 | |
899 | (defbinding tree-view-get-visible-rect () nil |
900 | (tree-view tree-view) |
2a8752b0 |
901 | ((make-instance 'gdk:rectangle) gdk:rectangle :return)) |
167450a3 |
902 | |
903 | ;; and many more functions which we'll add later |
904 | |
2a8752b0 |
905 | |
78a17735 |
906 | ;;;; Icon View |
907 | |
908 | #+gtk2.6 |
909 | (progn |
910 | (defbinding icon-view-get-path-at-pos () tree-path |
911 | (icon-view icon-view) |
912 | (x int) (y int)) |
2a8752b0 |
913 | |
56ccd5b7 |
914 | (define-callback-marshal %icon-view-foreach-callback nil (icon-view tree-path)) |
78a17735 |
915 | |
56ccd5b7 |
916 | (defbinding %icon-view-selected-foreach (icon-view callback-id) tree-path |
78a17735 |
917 | (icon-view icon-view) |
56ccd5b7 |
918 | (%icon-view-foreach-callback callback) |
78a17735 |
919 | (callback-id unsigned-int)) |
920 | |
921 | (defun icon-view-foreach (icon-view function) |
922 | (with-callback-function (id function) |
923 | (%icon-view-selected-foreach icon-view id))) |
924 | |
925 | (defbinding icon-view-select-path () nil |
926 | (icon-view icon-view) |
927 | (path tree-path)) |
928 | |
929 | (defbinding icon-view-unselect-path () nil |
930 | (icon-view icon-view) |
931 | (path tree-path)) |
932 | |
933 | (defbinding icon-view-path-is-selected-p () boolean |
934 | (icon-view icon-view) |
935 | (path tree-path)) |
936 | |
937 | (defbinding icon-view-get-selected-items () (glist tree-path) |
938 | (icon-view icon-view)) |
939 | |
940 | (defbinding icon-view-select-all () nil |
941 | (icon-view icon-view)) |
942 | |
943 | (defbinding icon-view-unselect-all () nil |
944 | (icon-view icon-view)) |
945 | |
946 | (defbinding icon-view-item-activated () nil |
947 | (icon-view icon-view) |
948 | (path tree-path)) |
949 | |
950 | (defbinding %icon-view-set-text-column (column icon-view) nil |
951 | (icon-view icon-view) |
952 | ((if (integerp column) |
953 | column |
954 | (column-index (icon-view-model icon-view) column)) int)) |
955 | |
956 | (defbinding %icon-view-set-markup-column (column icon-view) nil |
957 | (icon-view icon-view) |
958 | ((if (integerp column) |
959 | column |
960 | (column-index (icon-view-model icon-view) column)) int)) |
961 | |
962 | (defbinding %icon-view-set-pixbuf-column (column icon-view) nil |
963 | (icon-view icon-view) |
964 | ((if (integerp column) |
965 | column |
966 | (column-index (icon-view-model icon-view) column)) int))) |
bdc0e300 |
967 | |
968 | #+gtk2.8 |
969 | (progn |
970 | (defbinding icon-view-get-item-at-pos () boolean |
971 | (icon-view icon-view) |
972 | (x int) |
973 | (y int) |
974 | (tree-path tree-path :out) |
975 | (cell cell-renderer :out)) |
976 | |
977 | (defbinding icon-view-set-cursor (icon-view path &key cell start-editing) nil |
978 | (icon-view icon-view) |
979 | (path tree-path) |
980 | (cell (or null cell-renderer)) |
981 | (start-editing boolean)) |
982 | |
983 | (defbinding icon-view-get-cursor () boolean |
984 | (icon-view icon-view) |
985 | (path tree-path :out) |
986 | (cell cell-renderer :out)) |
987 | |
988 | (defbinding icon-view-get-dest-item-at-pos () boolean |
989 | (icon-view icon-view) |
990 | (drag-x int) |
991 | (drag-y int) |
992 | (tree-path tree-path :out) |
993 | (pos drop-position :out)) |
994 | |
995 | (defbinding icon-view-create-drag-icon () gdk:pixmap |
996 | (icon-view icon-view) |
997 | (tree-path tree-path)) |
998 | |
999 | (defbinding icon-view-scroll-to-path (icon-view tree-path &key row-align column-align) nil |
1000 | (icon-view icon-view) |
1001 | (tree-path tree-path) |
1002 | ((or row-align column-align) boolean) |
1003 | (row-align single-float) |
1004 | (column-align single-float)) |
1005 | |
1006 | (defbinding icon-view-get-visible-range () boolean |
1007 | (icon-view icon-view) |
1008 | (start-path tree-path :out) |
1009 | (end-path tree-path :out)) |
1010 | |
1011 | ;; (defbinding icon-view-enable-model-drag-source () nil |
1012 | ;; (icon-view icon-view) |
1013 | ;; (start-button-mask gdk:modifier-type) |
1014 | ;; (targets (vector target-entry)) |
1015 | ;; ((length targets) unsigned-int) |
1016 | ;; (actions gdk:drag-action)) |
1017 | |
1018 | ;; (defbinding icon-view-enable-model-drag-dest () nil |
1019 | ;; (icon-view icon-view) |
1020 | ;; (targets (vector target-entry)) |
1021 | ;; ((length targets) unsigned-int) |
1022 | ;; (actions gdk:drag-action)) |
1023 | |
1024 | (defbinding icon-view-unset-model-drag-source () nil |
1025 | (icon-view icon-view)) |
1026 | |
1027 | (defbinding icon-view-unset-model-drag-dest () nil |
1028 | (icon-view icon-view))) |