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

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