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.15 2006-02-19 19:31:15 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   (defmethod alien-type ((type (eql 'tree-path)) &rest args)
 225     (declare (ignore type args))
 226     (alien-type 'pointer))
 227
 228   (defmethod size-of ((type (eql 'tree-path)) &rest args)
 229     (declare (ignore type args))
 230     (size-of 'pointer))
 231
 232   (defmethod to-alien-form (path (type (eql 'tree-path)) &rest args)
 233     (declare (ignore type args))
 234     `(%make-tree-path ,path))
 235
 236   (defmethod from-alien-form (location (type (eql 'tree-path)) &rest args)
 237     (declare (ignore type args))
 238     `(let ((location ,location))
 239        (prog1
 240            (%tree-path-to-vector location)
 241          (%tree-path-free location))))
 242
 243   (defmethod copy-from-alien-form (location (type (eql 'tree-path)) &rest args)
 244     (declare (ignore type args))
 245     `(%tree-path-to-vector ,location))
 246
 247   (defmethod cleanup-form (location (type (eql 'tree-path)) &rest args)
 248     (declare (ignore type args))
 249     `(%tree-path-free ,location)))
 250
 251 (defmethod to-alien-function ((type (eql 'tree-path)) &rest args)
 252   (declare (ignore type args))
 253   #'%make-tree-path)
 254
 255 (defmethod from-alien-function ((type (eql 'tree-path)) &rest args)
 256   (declare (ignore type args))
 257   #'(lambda (location)
 258       (prog1
 259           (%tree-path-to-vector location)
 260         (%tree-path-free location))))
 261
 262 (defmethod copy-from-alien-function ((type (eql 'tree-path)) &rest args)
 263   (declare (ignore type args))
 264   #'%tree-path-to-vector)
 265
 266 (defmethod cleanup-function ((type (eql 'tree-path)) &rest args)
 267   (declare (ignore type args))
 268   #'%tree-path-free)
 269
 270 (defmethod writer-function ((type (eql 'tree-path)) &rest args)
 271   (declare (ignore type args))
 272   (let ((writer (writer-function 'pointer)))
 273     #'(lambda (path location &optional (offset 0))
 274         (funcall writer (%make-tree-path path) location offset))))
 275
 276 (defmethod reader-function ((type (eql 'tree-path)) &rest args)
 277   (declare (ignore type args))
 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 (defmethod destroy-function ((type (eql 'tree-path)) &rest args)
 284   (declare (ignore type args))
 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   (map 'vector
 409        #'(lambda (column)
 410            (find-type-number (first (mklist column))))
 411        columns))
 412
 413 (defun column-index (model column)
 414   (or
 415    (etypecase column
 416      (number column)
 417      (symbol (position column (object-data model 'column-names)))
 418      (string (position column (object-data model 'column-names)
 419                    :test #'string=)))
 420    (error "~A has no column ~S" model column)))
 421
 422 (defun column-name (model index)
 423   (svref (object-data model 'column-names) index))
 424
 425 (defun tree-model-column-value-setter (model column)
 426   (let ((setters (or
 427                   (object-data model 'column-setters)
 428                   (setf
 429                    (object-data model 'column-setters)
 430                    (make-array (tree-model-n-columns model)
 431                     :initial-element nil)))))
 432     (let ((index (column-index model column)))
 433     (or
 434      (svref setters index)
 435      (setf
 436       (svref setters index)
 437       (let ((setter
 438              (mkbinding (column-setter-name model)
 439               nil (type-of model) 'tree-iter 'int
 440 ;             (type-from-number (tree-model-get-column-type model index))
 441               (tree-model-get-column-type model index)
 442               'int)))
 443         #'(lambda (value iter)
 444             (funcall setter model iter index value -1))))))))
 445
 446 (defun tree-model-row-setter (model)
 447   (or
 448    (object-data model 'row-setter)
 449    (progn
 450      ;; This will create any missing column setter
 451      (loop
 452       for i from 0 below (tree-model-n-columns model)
 453       do (tree-model-column-value-setter model i))
 454      (let ((setters (object-data model 'column-setters)))
 455        (setf
 456         (object-data model 'row-setter)
 457         #'(lambda (row iter)
 458             (map nil #'(lambda (value setter)
 459                          (funcall setter value iter))
 460                  row setters)))))))
 461
 462 (defun (setf tree-model-value) (value model row column)
 463   (let ((iter (etypecase row
 464                 (tree-iter row)
 465                 (tree-path (multiple-value-bind (valid iter)
 466                                (tree-model-get-iter model row)
 467                              (if valid
 468                                  iter
 469                                (error "Invalid tree path: ~A" row)))))))
 470     (funcall (tree-model-column-value-setter model column) value iter)
 471     value))
 472
 473 (defun (setf tree-model-row-data) (data model iter)
 474   (funcall (tree-model-row-setter model) data iter)
 475   data)
 476
 477 (defun %tree-model-set (model iter data)
 478   (etypecase data
 479     (vector (setf (tree-model-row-data model iter) data))
 480     (cons
 481      (loop
 482       as (column value . rest) = data then rest
 483       do (setf (tree-model-value model iter column) value)
 484       while rest))))
 485
 486
 487 ;;; Tree Selection
 488
 489 (define-callback-marshal %tree-selection-callback boolean
 490   (tree-selection tree-model tree-path (path-currently-selected boolean)))
 491
 492 (defbinding tree-selection-set-select-function (selection function) nil
 493   (selection tree-selection)
 494   (%tree-selection-callback callback)
 495   ((register-callback-function function) unsigned-int)
 496   (user-data-destroy-callback callback))
 497
 498 (defbinding tree-selection-get-selected
 499     (selection &optional (iter (make-instance 'tree-iter))) boolean
 500   (selection tree-selection)
 501   (nil null)
 502   (iter tree-iter :return))
 503
 504 (define-callback-marshal %tree-selection-foreach-callback nil (tree-model tree-path tree-iter))
 505
 506 (defbinding %tree-selection-selected-foreach (tree-selection callback-id) nil
 507   (tree-selection tree-selection)
 508   (%tree-selection-foreach-callback callback)
 509   (callback-id unsigned-int))
 510
 511 (defun tree-selection-selected-foreach (selection function)
 512   (with-callback-function (id function)
 513     (%tree-selection-selected-foreach selection id)))
 514
 515 (defbinding tree-selection-get-selected-rows () (glist tree-path)
 516   (tree-selection tree-selection)
 517   (nil null))
 518
 519 (defbinding tree-selection-count-selected-rows () int
 520   (tree-selection tree-selection))
 521
 522 (defbinding %tree-selection-select-path () nil
 523   (tree-selection tree-selection)
 524   (tree-path tree-path))
 525
 526 (defbinding %tree-selection-unselect-path () nil
 527   (tree-selection tree-selection)
 528   (tree-path tree-path))
 529
 530 (defbinding %tree-selection-path-is-selected () boolean
 531   (tree-selection tree-selection)
 532   (tree-path tree-path))
 533
 534 (defbinding %tree-selection-select-iter () nil
 535   (tree-selection tree-selection)
 536   (tree-path tree-path))
 537
 538 (defbinding %tree-selection-unselect-iter () nil
 539   (tree-selection tree-selection)
 540   (tree-path tree-path))
 541
 542 (defbinding %tree-selection-iter-is-selected () boolean
 543   (tree-selection tree-selection)
 544   (tree-path tree-path))
 545
 546 (defun tree-selection-select (selection row)
 547   (etypecase row
 548     (tree-path (%tree-selection-select-path selection row))
 549     (tree-iter (%tree-selection-select-iter selection row))))
 550
 551 (defun tree-selection-unselect (selection row)
 552   (etypecase row
 553     (tree-path (%tree-selection-unselect-path selection row))
 554     (tree-iter (%tree-selection-unselect-iter selection row))))
 555
 556 (defun tree-selection-is-selected-p (selection row)
 557   (etypecase row
 558     (tree-path (%tree-selection-path-is-selected selection row))
 559     (tree-iter (%tree-selection-iter-is-selected selection row))))
 560
 561 (defbinding tree-selection-select-all () nil
 562   (tree-selection tree-selection))
 563
 564 (defbinding tree-selection-unselect-all () nil
 565   (tree-selection tree-selection))
 566
 567 (defbinding tree-selection-select-range () nil
 568   (tree-selection tree-selection)
 569   (start tree-path)
 570   (end tree-path))
 571
 572 (defbinding tree-selection-unselect-range () nil
 573   (tree-selection tree-selection)
 574   (start tree-path)
 575   (end tree-path))
 576
 577
 578 ;;; Tree Sortable
 579
 580 (eval-when (:compile-toplevel :load-toplevel :execute)
 581   (define-enum-type sort-column (:default -1) (:unsorted -2))
 582   (define-enum-type sort-order (:before -1) (:equal 0) (:after 1)))
 583
 584
 585 (define-callback-marshal %tree-iter-compare-callback (or int sort-order)
 586   (tree-model (a tree-iter) (b tree-iter)))
 587
 588 (defbinding tree-sortable-sort-column-changed () nil
 589   (sortable tree-sortable))
 590
 591 (defbinding %tree-sortable-get-sort-column-id () boolean
 592   (sortable tree-sortable)
 593   (column int :out)
 594   (order sort-type :out))
 595
 596 (defun tree-sortable-get-sort-column (sortable)
 597   (multiple-value-bind (special-p column order)
 598       (%tree-sortable-get-sort-column-id sortable)
 599     (values
 600      (if special-p
 601          (int-to-sort-order column)
 602        (column-name sortable column))
 603      order)))
 604
 605 (defbinding (tree-sortable-set-sort-column
 606              "gtk_tree_sortable_set_sort_column_id")
 607     (sortable column order) nil
 608   (sortable tree-sortable)
 609   ((etypecase column
 610      ((or integer sort-column) column)
 611      (symbol (column-index sortable column)))
 612    (or sort-column int))
 613   (order sort-type))
 614
 615 (defbinding %tree-sortable-set-sort-func (sortable column function) nil
 616   (sortable tree-sortable)
 617   ((column-index sortable column) int)
 618   (%tree-iter-compare-callback callback)
 619   ((register-callback-function function) unsigned-int)
 620   (user-data-destroy-callback callback))
 621
 622 (defbinding %tree-sortable-set-default-sort-func () nil
 623   (sortable tree-sortable)
 624   (compare-func (or null callback))
 625   (callback-id unsigned-int)
 626   (destroy-func (or null callback)))
 627
 628 (defun tree-sortable-set-sort-func (sortable column function)
 629   "Sets the comparison function used when sorting to be FUNCTION. If
 630 the current sort column of SORTABLE is the same as COLUMN,
 631 then the model will sort using this function."
 632   (cond
 633    ((and (eq column :default) (not function))
 634     (%tree-sortable-set-default-sort-func sortable nil 0 nil))
 635    ((eq column :default)
 636     (%tree-sortable-set-default-sort-func sortable
 637      %tree-iter-compare-callback
 638      (register-callback-function function)
 639      user-data-destroy-callback))
 640    ((%tree-sortable-set-sort-func sortable column function))))
 641
 642 (defbinding tree-sortable-has-default-sort-func-p () boolean
 643   (sortable tree-sortable))
 644
 645
 646 ;;; Tree Store
 647
 648 (defbinding %tree-store-set-column-types () nil
 649   (tree-store tree-store)
 650   ((length columns) unsigned-int)
 651   (columns (vector gtype)))
 652
 653 (defmethod initialize-instance ((tree-store tree-store) &key column-types
 654                                 column-names)
 655   (call-next-method)
 656   (%tree-store-set-column-types tree-store column-types)
 657   (when column-names
 658     (setf (object-data tree-store 'column-names) column-names)))
 659
 660 (defmethod column-setter-name ((tree-store tree-store))
 661   (declare (ignore tree-store))
 662   "gtk_tree_store_set")
 663
 664 (defbinding tree-store-remove () boolean
 665   (tree-store tree-store)
 666   (tree-iter tree-iter))
 667
 668 (defbinding %tree-store-insert () nil
 669   (tree-store tree-store)
 670   (tree-iter tree-iter)
 671   (parent (or null tree-iter))
 672   (position int))
 673
 674 (defun tree-store-insert
 675     (store parent position &optional data (iter (make-instance 'tree-iter)))
 676   (%tree-store-insert store iter parent position)
 677   (when data (%tree-model-set store iter data))
 678   iter)
 679
 680 (defbinding %tree-store-insert-before () nil
 681   (tree-store tree-store)
 682   (tree-iter tree-iter)
 683   (parent (or null tree-iter))
 684   (sibling (or null tree-iter)))
 685
 686 (defun tree-store-insert-before
 687     (store parent sibling &optional data (iter (make-instance 'tree-iter)))
 688   (%tree-store-insert-before store iter parent sibling)
 689   (when data (%tree-model-set store iter data))
 690   iter)
 691
 692 (defbinding %tree-store-insert-after () nil
 693   (tree-store tree-store)
 694   (tree-iter tree-iter)
 695   (parent (or null tree-iter))
 696   (sibling (or null tree-iter)))
 697
 698 (defun tree-store-insert-after
 699     (store parent sibling &optional data (iter (make-instance 'tree-iter)))
 700   (%tree-store-insert-after store iter parent sibling)
 701   (when data (%tree-model-set store iter data))
 702   iter)
 703
 704 (defbinding %tree-store-prepend () nil
 705   (tree-store tree-store)
 706   (tree-iter tree-iter)
 707   (parent (or null tree-iter)))
 708
 709 (defun tree-store-prepend
 710     (store parent &optional data (iter (make-instance 'tree-iter)))
 711   (%tree-store-prepend store iter parent)
 712   (when data (%tree-model-set store iter data))
 713   iter)
 714
 715 (defbinding %tree-store-append () nil
 716   (tree-store tree-store)
 717   (tree-iter tree-iter)
 718   (parent (or null tree-iter)))
 719
 720 (defun tree-store-append
 721     (store parent &optional data (iter (make-instance 'tree-iter)))
 722   (%tree-store-append store iter parent)
 723   (when data (%tree-model-set store iter data))
 724   iter)
 725
 726 (defbinding (tree-store-is-ancestor-p "gtk_tree_store_is_ancestor") () boolean
 727   (tree-store tree-store)
 728   (tree-iter tree-iter)
 729   (descendant tree-iter))
 730
 731 (defbinding tree-store-iter-depth () int
 732   (tree-store tree-store)
 733   (tree-iter tree-iter))
 734
 735 (defbinding tree-store-clear () nil
 736   (tree-store tree-store))
 737
 738 (defbinding tree-store-reorder () nil
 739   (tree-store tree-store)
 740   (parent tree-iter)
 741   (new-order (vector int)))
 742
 743 (defbinding tree-store-swap () nil
 744   (tree-store tree-store)
 745   (a tree-iter)
 746   (b tree-iter))
 747
 748 (defbinding tree-store-move-before () nil
 749   (tree-store tree-store)
 750   (iter tree-iter)
 751   (psoition (or null tree-iter)))
 752
 753
 754 (defbinding tree-store-move-after () nil
 755   (tree-store tree-store)
 756   (iter tree-iter)
 757   (psoition tree-iter))
 758
 759
 760
 761 ;;; Tree View
 762
 763 (defmethod initialize-instance ((tree-view tree-view) &rest initargs
 764                                 &key column)
 765   (call-next-method)
 766   (mapc #'(lambda (column)
 767             (tree-view-append-column tree-view column))
 768         (get-all initargs :column)))
 769
 770
 771 (defbinding tree-view-columns-autosize () nil
 772   (tree-view tree-view))
 773
 774 (defbinding tree-view-append-column () int
 775   (tree-view tree-view)
 776   (tree-view-column tree-view-column))
 777
 778 (defbinding tree-view-remove-column () int
 779   (tree-view tree-view)
 780   (tree-view-column tree-view-column))
 781
 782 (defbinding tree-view-insert-column (view column position) int
 783   (view tree-view)
 784   (column tree-view-column)
 785   ((if (eq position :end) -1 position) int))
 786
 787 (defbinding tree-view-get-column () tree-view-column
 788   (tree-view tree-view)
 789   (position int))
 790
 791 (defbinding tree-view-move-column-after () nil
 792   (tree-view tree-view)
 793   (column tree-view-column)
 794   (base-column (or null tree-view-column)))
 795
 796 ;;(defbinding tree-view-set-column drag-function ...)
 797
 798 (defbinding tree-view-scroll-to-point () nil
 799   (tree-view tree-view)
 800   (tree-x int)
 801   (tree-y int))
 802
 803 (defbinding tree-view-scroll-to-cell () nil
 804   (tree-view tree-view)
 805   (path (or null tree-path))
 806   (column (or null tree-view-column))
 807   (use-align boolean)
 808   (row-align single-float)
 809   (col-align single-float))
 810
 811 (defbinding tree-view-set-cursor () nil
 812   (tree-view tree-view)
 813   (path tree-path)
 814   (focus-column tree-view-column)
 815   (start-editing boolean))
 816
 817 (defbinding tree-view-set-cursor-on-cell () nil
 818   (tree-view tree-view)
 819   (path tree-path)
 820   (focus-column (or null tree-view-column))
 821   (focus-cell (or null cell-renderer))
 822   (start-editing boolean))
 823
 824 (defbinding tree-view-get-cursor () nil
 825   (tree-view tree-view)
 826   (path tree-path :out )
 827   (focus-column tree-view-column :out))
 828
 829 (defbinding tree-view-row-activated () nil
 830   (tree-view tree-view)
 831   (path tree-path )
 832   (column tree-view-column))
 833
 834 (defbinding tree-view-expand-all () nil
 835   (tree-view tree-view))
 836
 837 (defbinding tree-view-collapse-all () nil
 838   (tree-view tree-view))
 839
 840 (defbinding tree-view-expand-to-path () nil
 841   (tree-view tree-view)
 842   (path tree-path))
 843
 844 (defbinding tree-view-expand-row () nil
 845   (tree-view tree-view)
 846   (path tree-path)
 847   (open-all boolean))
 848
 849 (defbinding tree-view-collapse-row () nil
 850   (tree-view tree-view)
 851   (path tree-path))
 852
 853 (define-callback-marshal %tree-view-mapping-callback nil (tree-view tree-path))
 854
 855 (defbinding %tree-view-map-expanded-rows (tree-view callback-id) nil
 856   (tree-view tree-view)
 857   (%tree-view-mapping-callback callback)
 858   (callback-id unsigned-int))
 859
 860 (defun map-expanded-rows (function tree-view)
 861   (with-callback-function (id function)
 862     (%tree-view-map-expanded-rows tree-view id)))
 863
 864 (defbinding (tree-view-row-expanded-p "gtk_tree_view_row_expanded") () boolean
 865   (tree-view tree-view)
 866   (path tree-path))
 867
 868 (defbinding tree-view-get-path-at-pos
 869     (tree-view x y &optional (cell-x 0) (cell-y 0)) boolean
 870   (tree-view tree-view)
 871   (x int)
 872   (y int)
 873   (path tree-path :out)
 874   (column tree-view-column :out)
 875   (cell-x int)
 876   (cell-y int))
 877
 878 (defbinding tree-view-get-cell-area () nil
 879   (tree-view tree-view)
 880   (path (or null tree-path))
 881   (column (or null tree-view-column))
 882   ((make-instance 'gdk:rectangle) gdk:rectangle :return))
 883
 884 (defbinding tree-view-get-background-area () nil
 885   (tree-view tree-view)
 886   (path (or null tree-path))
 887   (column (or null tree-view-column))
 888   ((make-instance 'gdk:rectangle) gdk:rectangle :return))
 889
 890 (defbinding tree-view-get-visible-rect () nil
 891   (tree-view tree-view)
 892   ((make-instance 'gdk:rectangle) gdk:rectangle :return))
 893
 894 ;; and many more functions which we'll add later
 895
 896
 897 ;;;; Icon View
 898
 899 #+gtk2.6
 900 (progn
 901   (defbinding icon-view-get-path-at-pos () tree-path
 902     (icon-view icon-view)
 903     (x int) (y int))
 904
 905   (define-callback-marshal %icon-view-foreach-callback nil (icon-view tree-path))
 906
 907   (defbinding %icon-view-selected-foreach (icon-view callback-id) tree-path
 908     (icon-view icon-view)
 909     (%icon-view-foreach-callback callback)
 910     (callback-id unsigned-int))
 911
 912   (defun icon-view-foreach (icon-view function)
 913     (with-callback-function (id function)
 914       (%icon-view-selected-foreach icon-view id)))
 915
 916   (defbinding icon-view-select-path () nil
 917     (icon-view icon-view)
 918     (path tree-path))
 919
 920   (defbinding icon-view-unselect-path () nil
 921     (icon-view icon-view)
 922     (path tree-path))
 923
 924   (defbinding icon-view-path-is-selected-p () boolean
 925     (icon-view icon-view)
 926     (path tree-path))
 927
 928   (defbinding icon-view-get-selected-items () (glist tree-path)
 929     (icon-view icon-view))
 930
 931   (defbinding icon-view-select-all () nil
 932     (icon-view icon-view))
 933
 934   (defbinding icon-view-unselect-all () nil
 935     (icon-view icon-view))
 936
 937   (defbinding icon-view-item-activated () nil
 938     (icon-view icon-view)
 939     (path tree-path))
 940
 941   (defbinding %icon-view-set-text-column (column icon-view) nil
 942     (icon-view icon-view)
 943     ((if (integerp column)
 944          column
 945        (column-index (icon-view-model icon-view) column)) int))
 946
 947   (defbinding %icon-view-set-markup-column (column icon-view) nil
 948     (icon-view icon-view)
 949     ((if (integerp column)
 950          column
 951        (column-index (icon-view-model icon-view) column)) int))
 952
 953   (defbinding %icon-view-set-pixbuf-column (column icon-view) nil
 954     (icon-view icon-view)
 955     ((if (integerp column)
 956          column
 957        (column-index (icon-view-model icon-view) column)) int)))
 958
 959 #+gtk2.8
 960 (progn
 961   (defbinding icon-view-get-item-at-pos () boolean
 962     (icon-view icon-view)
 963     (x int)
 964     (y int)
 965     (tree-path tree-path :out)
 966     (cell cell-renderer :out))
 967
 968   (defbinding icon-view-set-cursor (icon-view path &key cell start-editing) nil
 969     (icon-view icon-view)
 970     (path tree-path)
 971     (cell (or null cell-renderer))
 972     (start-editing boolean))
 973
 974   (defbinding icon-view-get-cursor () boolean
 975     (icon-view icon-view)
 976     (path tree-path :out)
 977     (cell cell-renderer :out))
 978
 979   (defbinding icon-view-get-dest-item-at-pos () boolean
 980     (icon-view icon-view)
 981     (drag-x int)
 982     (drag-y int)
 983     (tree-path tree-path :out)
 984     (pos drop-position :out))
 985
 986   (defbinding icon-view-create-drag-icon () gdk:pixmap
 987     (icon-view icon-view)
 988     (tree-path tree-path))
 989
 990   (defbinding icon-view-scroll-to-path (icon-view tree-path &key row-align column-align) nil
 991     (icon-view icon-view)
 992     (tree-path tree-path)
 993     ((or row-align column-align) boolean)
 994     (row-align single-float)
 995     (column-align single-float))
 996
 997   (defbinding icon-view-get-visible-range () boolean
 998     (icon-view icon-view)
 999     (start-path tree-path :out)
1000     (end-path tree-path :out))
1001
1002 ;;   (defbinding icon-view-enable-model-drag-source () nil
1003 ;;     (icon-view icon-view)
1004 ;;     (start-button-mask gdk:modifier-type)
1005 ;;     (targets (vector target-entry))
1006 ;;     ((length targets) unsigned-int)
1007 ;;     (actions gdk:drag-action))
1008
1009 ;;   (defbinding icon-view-enable-model-drag-dest () nil
1010 ;;     (icon-view icon-view)
1011 ;;     (targets (vector target-entry))
1012 ;;     ((length targets) unsigned-int)
1013 ;;     (actions gdk:drag-action))
1014
1015   (defbinding icon-view-unset-model-drag-source () nil
1016     (icon-view icon-view))
1017
1018   (defbinding icon-view-unset-model-drag-dest () nil
1019     (icon-view icon-view)))