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