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