chiark - git - mdw - clg/blob - gtk/gtktree.lisp

   1 ;; Common Lisp bindings for GTK+ v2.x
   2 ;; Copyright 2004-2005 Espen S. Johnsen <espen@users.sf.net>
   3 ;;
   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:
  11 ;;
  12 ;; The above copyright notice and this permission notice shall be
  13 ;; included in all copies or substantial portions of the Software.
  14 ;;
  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
  23 ;; $Id: gtktree.lisp,v 1.18 2006-03-03 19:00:12 espen Exp $
  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
  46
  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
  55 (defbinding cell-layout-add-attribute (cell-layout cell attribute column) nil
  56   (cell-layout cell-layout)
  57   (cell cell-renderer)
  58   ((string-downcase attribute) string)
  59   (column int))
  60
  61 (define-callback-marshal %cell-layout-data-callback nil
  62   (cell-layout cell-renderer tree-model tree-iter))
  63
  64 (defbinding cell-layout-set-cell-data-func (cell-layout cell function) nil
  65   (cell-layout cell-layout)
  66   (cell cell-renderer)
  67   (%cell-layout-data-callback callback)
  68   ((register-callback-function function) unsigned-int)
  69   (user-data-destroy-callback callback))
  70
  71 (defbinding cell-layout-clear-attributes () nil
  72   (cell-layout cell-layout)
  73   (cell cell-renderer))
  74
  75
  76
  77 ;;;; List Store
  78
  79 (defmethod initialize-instance ((list-store list-store) &key column-types
  80                                 column-names initial-content)
  81   (call-next-method)
  82   (%list-store-set-column-types list-store column-types)
  83   (when column-names
  84     (setf
  85      (object-data list-store 'column-names)
  86      (coerce column-names 'vector)))
  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))))
  92
  93 (defgeneric column-setter-name (store))
  94
  95 (defmethod column-setter-name ((list-store list-store))
  96   (declare (ignore list-store))
  97   "gtk_list_store_set")
  98
  99 (defbinding %list-store-set-column-types () nil
 100   (list-store list-store)
 101   ((length columns) unsigned-int)
 102   (columns (vector gtype)))
 103
 104 (defbinding %list-store-remove () boolean
 105   (list-store list-store)
 106   (tree-iter tree-iter))
 107
 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)
 116            (error "~A not poiniting to a valid iterator in ~A" row store))))
 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
 124 (defbinding %list-store-insert () nil
 125   (list-store list-store)
 126   (tree-iter tree-iter)
 127   (position int))
 128
 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
 136   (list-store list-store)
 137   (tree-iter tree-iter)
 138   (sibling (or null tree-iter)))
 139
 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
 148   (list-store list-store)
 149   (tree-iter tree-iter)
 150   (sibling (or null tree-iter)))
 151
 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
 159   (list-store list-store)
 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)
 167
 168 (defbinding %list-store-append () nil
 169   (list-store list-store)
 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)
 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
 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
 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
 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))))
 225
 226 (eval-when (:compile-toplevel :load-toplevel :execute)
 227   (define-type-method alien-type ((type tree-path))
 228     (declare (ignore type))
 229     (alien-type 'pointer))
 230
 231   (define-type-method size-of ((type tree-path))
 232     (declare (ignore type))
 233     (size-of 'pointer))
 234
 235   (define-type-method to-alien-form ((type tree-path) path)
 236     (declare (ignore type))
 237     `(%make-tree-path ,path))
 238
 239   (define-type-method from-alien-form ((type tree-path) location)
 240     (declare (ignore type))
 241     `(let ((location ,location))
 242        (prog1
 243            (%tree-path-to-vector location)
 244          (%tree-path-free location))))
 245
 246   (define-type-method copy-from-alien-form ((type tree-path) location)
 247     (declare (ignore type))
 248     `(%tree-path-to-vector ,location))
 249
 250   (define-type-method cleanup-form ((type tree-path) location)
 251     (declare (ignore type))
 252     `(%tree-path-free ,location)))
 253
 254 (define-type-method to-alien-function ((type tree-path))
 255   (declare (ignore type))
 256   #'%make-tree-path)
 257
 258 (define-type-method from-alien-function ((type tree-path))
 259   (declare (ignore type))
 260   #'(lambda (location)
 261       (prog1
 262           (%tree-path-to-vector location)
 263         (%tree-path-free location))))
 264
 265 (define-type-method copy-from-alien-function ((type tree-path))
 266   (declare (ignore type ))
 267   #'%tree-path-to-vector)
 268
 269 (define-type-method cleanup-function ((type tree-path))
 270   (declare (ignore type))
 271   #'%tree-path-free)
 272
 273 (define-type-method writer-function ((type tree-path))
 274   (declare (ignore type))
 275   (let ((writer (writer-function 'pointer)))
 276     #'(lambda (path location &optional (offset 0))
 277         (funcall writer (%make-tree-path path) location offset))))
 278
 279 (define-type-method reader-function ((type tree-path))
 280   (declare (ignore type))
 281   (let ((reader (reader-function 'pointer)))
 282     #'(lambda (location &optional (offset 0) weak-p)
 283         (declare (ignore weak-p))
 284         (%tree-path-to-vector (funcall reader location offset)))))
 285
 286 (define-type-method destroy-function ((type tree-path))
 287   (declare (ignore type))
 288   (let ((reader (reader-function 'pointer)))
 289     #'(lambda (location &optional (offset 0))
 290         (%tree-path-free (funcall reader location offset)))))
 291
 292
 293 (defbinding %tree-row-reference-new () pointer
 294   (model tree-model)
 295   (path tree-path))
 296
 297 (defmethod allocate-foreign ((reference tree-row-reference) &key model path)
 298   (%tree-row-reference-new model path))
 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
 307 (defbinding tree-model-get-column-type () gtype ;type-number
 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
 327 (defgeneric tree-model-value (model row column))
 328
 329 (defmethod tree-model-value ((model tree-model) row column)
 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)))))))
 338     (with-gvalue (gvalue)
 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
 361     (tree-model parent n &optional (iter (make-instance 'tree-iter))) boolean
 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
 373 (define-callback-marshal %tree-model-foreach-callback boolean
 374   (tree-model tree-path tree-iter))
 375
 376 (defbinding %tree-model-foreach (tree-model callback-id) nil
 377   (tree-model tree-model)
 378   (%tree-model-foreach-callback callback)
 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)
 413   (declare (ignore model))
 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
 428 (defun column-name (model index)
 429   (svref (object-data model 'column-names) index))
 430
 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
 446 ;             (type-from-number (tree-model-get-column-type model index))
 447               (tree-model-get-column-type model index)
 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
 468 (defgeneric (setf tree-model-value) (value model row column))
 469
 470 (defmethod (setf tree-model-value) (value (model tree-model) row column)
 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))
 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
 491       do (setf (tree-model-value model iter column) value)
 492       while rest))))
 493
 494
 495 ;;; Tree Selection
 496
 497 (define-callback-marshal %tree-selection-callback boolean
 498   (tree-selection tree-model tree-path (path-currently-selected boolean)))
 499
 500 (defbinding tree-selection-set-select-function (selection function) nil
 501   (selection tree-selection)
 502   (%tree-selection-callback callback)
 503   ((register-callback-function function) unsigned-int)
 504   (user-data-destroy-callback callback))
 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
 512 (define-callback-marshal %tree-selection-foreach-callback nil (tree-model tree-path tree-iter))
 513
 514 (defbinding %tree-selection-selected-foreach (tree-selection callback-id) nil
 515   (tree-selection tree-selection)
 516   (%tree-selection-foreach-callback callback)
 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
 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
 593 (define-callback-marshal %tree-iter-compare-callback (or int sort-order)
 594   (tree-model (a tree-iter) (b tree-iter)))
 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)
 626   (%tree-iter-compare-callback callback)
 627   ((register-callback-function function) unsigned-int)
 628   (user-data-destroy-callback callback))
 629
 630 (defbinding %tree-sortable-set-default-sort-func () nil
 631   (sortable tree-sortable)
 632   (compare-func (or null callback))
 633   (callback-id unsigned-int)
 634   (destroy-func (or null callback)))
 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
 645      %tree-iter-compare-callback
 646      (register-callback-function function)
 647      user-data-destroy-callback))
 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
 653
 654 ;;; Tree Store
 655
 656 (defbinding %tree-store-set-column-types () nil
 657   (tree-store tree-store)
 658   ((length columns) unsigned-int)
 659   (columns (vector gtype)))
 660
 661 (defmethod initialize-instance ((tree-store tree-store) &key column-types
 662                                 column-names)
 663   (call-next-method)
 664   (%tree-store-set-column-types tree-store column-types)
 665   (when column-names
 666     (setf (object-data tree-store 'column-names) column-names)))
 667
 668 (defmethod column-setter-name ((tree-store tree-store))
 669   (declare (ignore tree-store))
 670   "gtk_tree_store_set")
 671
 672 (defbinding tree-store-remove () boolean
 673   (tree-store tree-store)
 674   (tree-iter tree-iter))
 675
 676 (defbinding %tree-store-insert () nil
 677   (tree-store tree-store)
 678   (tree-iter tree-iter)
 679   (parent (or null tree-iter))
 680   (position int))
 681
 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
 689   (tree-store tree-store)
 690   (tree-iter tree-iter)
 691   (parent (or null tree-iter))
 692   (sibling (or null tree-iter)))
 693
 694 (defun tree-store-insert-before
 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
 701   (tree-store tree-store)
 702   (tree-iter tree-iter)
 703   (parent (or null tree-iter))
 704   (sibling (or null tree-iter)))
 705
 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
 713   (tree-store tree-store)
 714   (tree-iter tree-iter)
 715   (parent (or null tree-iter)))
 716
 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
 724   (tree-store tree-store)
 725   (tree-iter tree-iter)
 726   (parent (or null tree-iter)))
 727
 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
 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
 771 (defmethod initialize-instance ((tree-view tree-view) &rest initargs
 772                                 &key column)
 773   (declare (ignore column))
 774   (call-next-method)
 775   (mapc #'(lambda (column)
 776             (tree-view-append-column tree-view column))
 777         (get-all initargs :column)))
 778
 779
 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
 791 (defbinding tree-view-insert-column (view column position) int
 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
 862 (define-callback-marshal %tree-view-mapping-callback nil (tree-view tree-path))
 863
 864 (defbinding %tree-view-map-expanded-rows (tree-view callback-id) nil
 865   (tree-view tree-view)
 866   (%tree-view-mapping-callback callback)
 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))
 891   ((make-instance 'gdk:rectangle) gdk:rectangle :return))
 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))
 897   ((make-instance 'gdk:rectangle) gdk:rectangle :return))
 898
 899 (defbinding tree-view-get-visible-rect () nil
 900   (tree-view tree-view)
 901   ((make-instance 'gdk:rectangle) gdk:rectangle :return))
 902
 903 ;; and many more functions which we'll add later
 904
 905
 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))
 913
 914   (define-callback-marshal %icon-view-foreach-callback nil (icon-view tree-path))
 915
 916   (defbinding %icon-view-selected-foreach (icon-view callback-id) tree-path
 917     (icon-view icon-view)
 918     (%icon-view-foreach-callback callback)
 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)))
 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)))