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.10 2005-04-23 16:48:52 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 (def-callback-marshal %cell-layout-data-func
  62     (nil cell-layout cell-renderer tree-model (copy-of 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-func callback)
  68   ((register-callback-function function) unsigned-int)
  69   (user-data-destroy-func 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))
 280         (%tree-path-to-vector (funcall reader location offset)))))
 281
 282 (defmethod destroy-function ((type (eql 'tree-path)) &rest args)
 283   (declare (ignore type args))
 284   (let ((reader (reader-function 'pointer)))
 285     #'(lambda (location &optional (offset 0))
 286         (%tree-path-free (funcall reader location offset)))))
 287
 288
 289 (defbinding %tree-row-reference-new () pointer
 290   (model tree-model)
 291   (path tree-path))
 292
 293 (defmethod initialize-instance ((reference tree-row-reference) &key model path)
 294   (setf
 295    (slot-value reference 'location)
 296    (%tree-row-reference-new model path))
 297   (call-next-method))
 298
 299 (defbinding tree-row-reference-get-path () tree-path
 300   (reference tree-row-reference))
 301
 302 (defbinding (tree-row-reference-valid-p "gtk_tree_row_reference_valid") () boolean
 303   (reference tree-row-reference))
 304
 305
 306 (defbinding tree-model-get-column-type () gtype ;type-number
 307   (tree-model tree-model)
 308   (index int))
 309
 310 (defbinding tree-model-get-iter
 311     (model path &optional (iter (make-instance 'tree-iter))) boolean
 312   (model tree-model)
 313   (iter tree-iter :return)
 314   (path tree-path))
 315
 316 (defbinding tree-model-get-path () tree-path
 317   (tree-model tree-model)
 318   (iter tree-iter))
 319
 320 (defbinding %tree-model-get-value () nil
 321   (tree-model tree-model)
 322   (iter tree-iter)
 323   (column int)
 324   (gvalue gvalue))
 325
 326 (defun tree-model-value (model row column)
 327   (let ((index (column-index model column))
 328         (iter (etypecase row
 329                 (tree-iter row)
 330                 (tree-path (multiple-value-bind (valid iter)
 331                                (tree-model-get-iter model row)
 332                              (if valid
 333                                  iter
 334                                (error "Invalid tree path: ~A" row)))))))
 335     (with-gvalue (gvalue)
 336       (%tree-model-get-value model iter index gvalue))))
 337
 338 (defbinding tree-model-iter-next () boolean
 339   (tree-model tree-model)
 340   (iter tree-iter :return))
 341
 342 (defbinding tree-model-iter-children
 343     (tree-model parent &optional (iter (make-instance 'tree-iter))) boolean
 344   (tree-model tree-model)
 345   (iter tree-iter :return)
 346   (parent (or null tree-iter)))
 347
 348 (defbinding (tree-model-iter-has-child-p "gtk_tree_model_iter_has_child")
 349     () boolean
 350   (tree-model tree-model)
 351   (iter tree-iter))
 352
 353 (defbinding tree-model-iter-n-children () int
 354   (tree-model tree-model)
 355   (iter tree-iter))
 356
 357 (defbinding tree-model-iter-nth-child
 358     (tree-model parent n &optional (iter (make-instance 'tree-iter))) boolean
 359   (tree-model tree-model)
 360   (iter tree-iter :return)
 361   (parent (or null tree-iter))
 362   (n int))
 363
 364 (defbinding tree-model-iter-parent
 365     (tree-model child &optional (iter (make-instance 'tree-iter))) boolean
 366   (tree-model tree-model)
 367   (iter tree-iter :return)
 368   (child tree-iter))
 369
 370 (def-callback-marshal %tree-model-foreach-func
 371   (boolean tree-model (path (copy-of tree-path)) (iter (copy-of tree-iter))))
 372
 373 (defbinding %tree-model-foreach () nil
 374   (tree-model tree-model)
 375   ((progn %tree-model-foreach-func) callback)
 376   (callback-id unsigned-int))
 377
 378 (defun tree-model-foreach (model function)
 379   (with-callback-function (id function)
 380     (%tree-model-foreach model id)))
 381
 382 (defbinding tree-model-row-changed () nil
 383   (tree-model tree-model)
 384   (path tree-path)
 385   (iter tree-iter))
 386
 387 (defbinding tree-model-row-inserted () nil
 388   (tree-model tree-model)
 389   (path tree-path)
 390   (iter tree-iter))
 391
 392 (defbinding tree-model-row-has-child-toggled () nil
 393   (tree-model tree-model)
 394   (path tree-path)
 395   (iter tree-iter))
 396
 397 (defbinding tree-model-row-deleted () nil
 398   (tree-model tree-model)
 399   (path tree-path)
 400   (iter tree-iter))
 401
 402 (defbinding tree-model-rows-reordered () nil
 403   (tree-model tree-model)
 404   (path tree-path)
 405   (iter tree-iter)
 406   (new-order int))
 407
 408
 409 (defun column-types (model columns)
 410   (map 'vector
 411        #'(lambda (column)
 412            (find-type-number (first (mklist column))))
 413        columns))
 414
 415 (defun column-index (model column)
 416   (or
 417    (etypecase column
 418      (number column)
 419      (symbol (position column (object-data model 'column-names)))
 420      (string (position column (object-data model 'column-names)
 421                    :test #'string=)))
 422    (error "~A has no column ~S" model column)))
 423
 424 (defun column-name (model index)
 425   (svref (object-data model 'column-names) index))
 426
 427 (defun tree-model-column-value-setter (model column)
 428   (let ((setters (or
 429                   (object-data model 'column-setters)
 430                   (setf
 431                    (object-data model 'column-setters)
 432                    (make-array (tree-model-n-columns model)
 433                     :initial-element nil)))))
 434     (let ((index (column-index model column)))
 435     (or
 436      (svref setters index)
 437      (setf
 438       (svref setters index)
 439       (let ((setter
 440              (mkbinding (column-setter-name model)
 441               nil (type-of model) 'tree-iter 'int
 442 ;             (type-from-number (tree-model-get-column-type model index))
 443               (tree-model-get-column-type model index)
 444               'int)))
 445         #'(lambda (value iter)
 446             (funcall setter model iter index value -1))))))))
 447
 448 (defun tree-model-row-setter (model)
 449   (or
 450    (object-data model 'row-setter)
 451    (progn
 452      ;; This will create any missing column setter
 453      (loop
 454       for i from 0 below (tree-model-n-columns model)
 455       do (tree-model-column-value-setter model i))
 456      (let ((setters (object-data model 'column-setters)))
 457        (setf
 458         (object-data model 'row-setter)
 459         #'(lambda (row iter)
 460             (map nil #'(lambda (value setter)
 461                          (funcall setter value iter))
 462                  row setters)))))))
 463
 464 (defun (setf tree-model-value) (value model row column)
 465   (let ((iter (etypecase row
 466                 (tree-iter row)
 467                 (tree-path (multiple-value-bind (valid iter)
 468                                (tree-model-get-iter model row)
 469                              (if valid
 470                                  iter
 471                                (error "Invalid tree path: ~A" row)))))))
 472     (funcall (tree-model-column-value-setter model column) value iter)
 473     value))
 474
 475 (defun (setf tree-model-row-data) (data model iter)
 476   (funcall (tree-model-row-setter model) data iter)
 477   data)
 478
 479 (defun %tree-model-set (model iter data)
 480   (etypecase data
 481     (vector (setf (tree-model-row-data model iter) data))
 482     (cons
 483      (loop
 484       as (column value . rest) = data then rest
 485       do (setf (tree-model-value model iter column) value)
 486       while rest))))
 487
 488
 489 ;;; Tree Selection
 490
 491 (def-callback-marshal %tree-selection-func (boolean tree-selection tree-model (path (copy-of tree-path)) (path-currently-selected boolean)))
 492
 493 (defbinding tree-selection-set-select-function (selection function) nil
 494   (selection tree-selection)
 495   (%tree-selection-func callback)
 496   ((register-callback-function function) unsigned-int)
 497   (user-data-destroy-func 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 (def-callback-marshal %tree-selection-foreach-func (nil tree-model (path (copy-of tree-path)) (iter (copy-of tree-iter))))
 506
 507 (defbinding %tree-selection-selected-foreach () nil
 508   (tree-selection tree-selection)
 509   ((progn %tree-selection-foreach-func) 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 (def-callback-marshal %tree-iter-compare-func
 587   ((or int sort-order) tree-model (a (copy-of tree-iter)) (b (copy-of 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-func callback)
 620   ((register-callback-function function) unsigned-int)
 621   (user-data-destroy-func callback))
 622
 623 (defbinding %tree-sortable-set-default-sort-func () nil
 624   (sortable tree-sortable)
 625   (compare-func (or null pointer))
 626   (callback-id unsigned-int)
 627   (destroy-func (or null pointer)))
 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      (callback %tree-iter-compare-func)
 639      (register-callback-function function)
 640      (callback user-data-destroy-func)))
 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   (call-next-method)
 767   (mapc #'(lambda (column)
 768             (tree-view-append-column tree-view column))
 769         (get-all initargs :column)))
 770
 771
 772 (defbinding tree-view-columns-autosize () nil
 773   (tree-view tree-view))
 774
 775 (defbinding tree-view-append-column () int
 776   (tree-view tree-view)
 777   (tree-view-column tree-view-column))
 778
 779 (defbinding tree-view-remove-column () int
 780   (tree-view tree-view)
 781   (tree-view-column tree-view-column))
 782
 783 (defbinding tree-view-insert-column (view column position) int
 784   (view tree-view)
 785   (column tree-view-column)
 786   ((if (eq position :end) -1 position) int))
 787
 788 (defbinding tree-view-get-column () tree-view-column
 789   (tree-view tree-view)
 790   (position int))
 791
 792 (defbinding tree-view-move-column-after () nil
 793   (tree-view tree-view)
 794   (column tree-view-column)
 795   (base-column (or null tree-view-column)))
 796
 797 ;;(defbinding tree-view-set-column drag-function ...)
 798
 799 (defbinding tree-view-scroll-to-point () nil
 800   (tree-view tree-view)
 801   (tree-x int)
 802   (tree-y int))
 803
 804 (defbinding tree-view-scroll-to-cell () nil
 805   (tree-view tree-view)
 806   (path (or null tree-path))
 807   (column (or null tree-view-column))
 808   (use-align boolean)
 809   (row-align single-float)
 810   (col-align single-float))
 811
 812 (defbinding tree-view-set-cursor () nil
 813   (tree-view tree-view)
 814   (path tree-path)
 815   (focus-column tree-view-column)
 816   (start-editing boolean))
 817
 818 (defbinding tree-view-set-cursor-on-cell () nil
 819   (tree-view tree-view)
 820   (path tree-path)
 821   (focus-column (or null tree-view-column))
 822   (focus-cell (or null cell-renderer))
 823   (start-editing boolean))
 824
 825 (defbinding tree-view-get-cursor () nil
 826   (tree-view tree-view)
 827   (path tree-path :out )
 828   (focus-column tree-view-column :out))
 829
 830 (defbinding tree-view-row-activated () nil
 831   (tree-view tree-view)
 832   (path tree-path )
 833   (column tree-view-column))
 834
 835 (defbinding tree-view-expand-all () nil
 836   (tree-view tree-view))
 837
 838 (defbinding tree-view-collapse-all () nil
 839   (tree-view tree-view))
 840
 841 (defbinding tree-view-expand-to-path () nil
 842   (tree-view tree-view)
 843   (path tree-path))
 844
 845 (defbinding tree-view-expand-row () nil
 846   (tree-view tree-view)
 847   (path tree-path)
 848   (open-all boolean))
 849
 850 (defbinding tree-view-collapse-row () nil
 851   (tree-view tree-view)
 852   (path tree-path))
 853
 854 (def-callback-marshal %tree-view-mapping-func (nil tree-view (path (copy-of tree-path))))
 855
 856 (defbinding %tree-view-map-expanded-rows () nil
 857   (tree-view tree-view)
 858   ((progn %tree-view-mapping-func) callback)
 859   (callback-id unsigned-int))
 860
 861 (defun map-expanded-rows (function tree-view)
 862   (with-callback-function (id function)
 863     (%tree-view-map-expanded-rows tree-view id)))
 864
 865 (defbinding (tree-view-row-expanded-p "gtk_tree_view_row_expanded") () boolean
 866   (tree-view tree-view)
 867   (path tree-path))
 868
 869 (defbinding tree-view-get-path-at-pos
 870     (tree-view x y &optional (cell-x 0) (cell-y 0)) boolean
 871   (tree-view tree-view)
 872   (x int)
 873   (y int)
 874   (path tree-path :out)
 875   (column tree-view-column :out)
 876   (cell-x int)
 877   (cell-y int))
 878
 879 (defbinding tree-view-get-cell-area () nil
 880   (tree-view tree-view)
 881   (path (or null tree-path))
 882   (column (or null tree-view-column))
 883   ((make-instance 'gdk:rectangle) gdk:rectangle :return))
 884
 885 (defbinding tree-view-get-background-area () nil
 886   (tree-view tree-view)
 887   (path (or null tree-path))
 888   (column (or null tree-view-column))
 889   ((make-instance 'gdk:rectangle) gdk:rectangle :return))
 890
 891 (defbinding tree-view-get-visible-rect () nil
 892   (tree-view tree-view)
 893   ((make-instance 'gdk:rectangle) gdk:rectangle :return))
 894
 895 ;; and many more functions which we'll add later
 896
 897
 898 ;;;; Icon View
 899
 900 #+gtk2.6
 901 (progn
 902   (defbinding icon-view-get-path-at-pos () tree-path
 903     (icon-view icon-view)
 904     (x int) (y int))
 905
 906   (def-callback-marshal %icon-view-foreach-func
 907     (nil icon-view (path (copy-of tree-path))))
 908
 909   (defbinding %icon-view-selected-foreach () tree-path
 910     (icon-view icon-view)
 911     ((progn %icon-view-foreach-func) 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)))