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