X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/167450a314d73a284308da7bd4117302ded4f0dc..7ce4015bab6f4366baf5b9321fb3fad094625305:/gtk/gtktree.lisp diff --git a/gtk/gtktree.lisp b/gtk/gtktree.lisp index caae594..1ba05f5 100644 --- a/gtk/gtktree.lisp +++ b/gtk/gtktree.lisp @@ -1,21 +1,26 @@ -;; Common Lisp bindings for GTK+ v2.0 -;; Copyright (C) 1999-2001 Espen S. Johnsen +;; Common Lisp bindings for GTK+ v2.x +;; Copyright 2004-2005 Espen S. Johnsen ;; -;; This library is free software; you can redistribute it and/or -;; modify it under the terms of the GNU Lesser General Public -;; License as published by the Free Software Foundation; either -;; version 2 of the License, or (at your option) any later version. +;; Permission is hereby granted, free of charge, to any person obtaining +;; a copy of this software and associated documentation files (the +;; "Software"), to deal in the Software without restriction, including +;; without limitation the rights to use, copy, modify, merge, publish, +;; distribute, sublicense, and/or sell copies of the Software, and to +;; permit persons to whom the Software is furnished to do so, subject to +;; the following conditions: ;; -;; This library is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; Lesser General Public License for more details. +;; The above copyright notice and this permission notice shall be +;; included in all copies or substantial portions of the Software. ;; -;; You should have received a copy of the GNU Lesser General Public -;; License along with this library; if not, write to the Free Software -;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: gtktree.lisp,v 1.1 2004-11-07 17:22:06 espen Exp $ +;; $Id: gtktree.lisp,v 1.11 2005-09-26 21:34:53 espen Exp $ (in-package "GTK") @@ -38,6 +43,7 @@ (defun cell-layout-pack (layout cell &key end expand) (cell-layout-pack-end layout cell expand) (cell-layout-pack-start layout cell expand))) + (defbinding cell-layout-reorder () nil (cell-layout cell-layout) (cell cell-renderer) @@ -53,14 +59,14 @@ (defbinding cell-layout-add-attribute (cell-layout cell attribute column) nil (column int)) (def-callback-marshal %cell-layout-data-func - (nil cell-layout cell-renderer tree-model tree-iter)) + (nil cell-layout cell-renderer tree-model (copy-of tree-iter))) (defbinding cell-layout-set-cell-data-func (cell-layout cell function) nil (cell-layout cell-layout) (cell cell-renderer) - ((callback %cell-layout-data-func) pointer) + (%cell-layout-data-func callback) ((register-callback-function function) unsigned-int) - ((callback %destroy-user-data) pointer)) + (user-data-destroy-func callback)) (defbinding cell-layout-clear-attributes () nil (cell-layout cell-layout) @@ -70,55 +76,101 @@ (defbinding cell-layout-clear-attributes () nil ;;;; List Store -(defmethod initialize-instance ((list-store list-store) &key columns) +(defmethod initialize-instance ((list-store list-store) &key column-types + column-names initial-content) (call-next-method) - (%list-store-set-column-types list-store (length columns) - (map 'vector #'find-type-number columns))) + (%list-store-set-column-types list-store column-types) + (when column-names + (setf (object-data list-store 'column-names) column-names)) + (when initial-content + (loop + with iter = (make-instance 'tree-iter) + for row in initial-content + do (list-store-append list-store row iter)))) -(defbinding %list-store-set-column-types () nil - (list-store list-store) - (n-columns unsigned-int) - (columns (vector type-number))) +(defmethod column-setter-name ((list-store list-store)) + (declare (ignore list-store)) + "gtk_list_store_set") -(defbinding %list-store-set-value () nil +(defbinding %list-store-set-column-types () nil (list-store list-store) - (tree-iter tree-iter) - (column int) - (value gvalue)) - -(defun list-store-set-value (list-store tree-iter column type value) - (let ((gvalue (gvalue-new type value))) - (unwind-protect - (%list-store-set-value list-store tree-iter column gvalue) - (gvalue-free gvalue)))) + ((length columns) unsigned-int) + (columns (vector gtype))) -(defbinding list-store-remove () boolean +(defbinding %list-store-remove () boolean (list-store list-store) (tree-iter tree-iter)) -(defbinding list-store-insert () nil +(defun list-store-remove (store row) + (etypecase row + (tree-iter + (%list-store-remove store row)) + (tree-path + (multiple-value-bind (valid iter) (tree-model-get-iter store row) + (if valid + (%list-store-remove store iter) + (error "~A not poiniting to a valid iterator in ~A" row store)))) + (tree-row-reference + (let ((path (tree-row-reference-get-path row))) + (if path + (list-store-remove store path) + (error "~A not valid" row)))))) + + +(defbinding %list-store-insert () nil (list-store list-store) - ((make-instance 'tree-iter) tree-iter :in-out) + (tree-iter tree-iter) (position int)) -(defbinding list-store-insert-before (list-store &optional sibling) nil +(defun list-store-insert + (store position &optional data (iter (make-instance 'tree-iter))) + (%list-store-insert store iter position) + (when data (%tree-model-set store iter data)) + iter) + +(defbinding %list-store-insert-before () nil (list-store list-store) - ((make-instance 'tree-iter) tree-iter :in-out) + (tree-iter tree-iter) (sibling (or null tree-iter))) -(defbinding list-store-insert-after (list-store &optional sibling) nil +(defun list-store-insert-before + (store sibling &optional data (iter (make-instance 'tree-iter))) + (%list-store-insert-before store iter sibling) + (when data (%tree-model-set store iter data)) + iter) + +(defbinding %list-store-insert-after + (list-store &optional sibling (tree-iter (make-instance 'tree-iter))) nil (list-store list-store) - ((make-instance 'tree-iter) tree-iter :in-out) + (tree-iter tree-iter) (sibling (or null tree-iter))) -(defbinding list-store-prepend () nil +(defun list-store-insert-after + (store sibling &optional data (iter (make-instance 'tree-iter))) + (%list-store-insert-after store iter sibling) + (when data (%tree-model-set store iter data)) + iter) + +(defbinding %list-store-prepend () nil (list-store list-store) - ((make-instance 'tree-iter) tree-iter :in-out)) + (tree-iter tree-iter)) + +(defun list-store-prepend + (store &optional data (iter (make-instance 'tree-iter))) + (%list-store-prepend store iter) + (when data (%tree-model-set store iter data)) + iter) -(defbinding list-store-append () nil +(defbinding %list-store-append () nil (list-store list-store) - ((make-instance 'tree-iter) tree-iter :in-out)) + (tree-iter tree-iter)) + +(defun list-store-append + (store &optional data (iter (make-instance 'tree-iter))) + (%list-store-append store iter) + (when data (%tree-model-set store iter data)) + iter) (defbinding list-store-clear () nil (list-store list-store)) @@ -137,7 +189,6 @@ (defbinding list-store-move-before () nil (iter tree-iter) (psoition (or null tree-iter))) - (defbinding list-store-move-after () nil (list-store list-store) (iter tree-iter) @@ -146,59 +197,533 @@ (defbinding list-store-move-after () nil ;;; Tree Model +(defbinding %tree-path-free () nil + (location pointer)) + +(defbinding %tree-path-get-indices () pointer + (location pointer)) + +(defbinding %tree-path-get-depth () int + (location pointer)) + +(defun %make-tree-path (path) + (let ((c-vector (make-c-vector 'int (length path) path)) + (location (allocate-memory (+ (size-of 'int) (size-of 'pointer))))) + (funcall (writer-function 'int) (length path) location) + (funcall (writer-function 'pointer) c-vector location (size-of 'int)) + location)) + +(defun %tree-path-to-vector (location) + (let ((indices (%tree-path-get-indices location)) + (depth (%tree-path-get-depth location))) + (if (null-pointer-p indices) + #() + (map-c-vector 'vector #'identity indices 'int depth)))) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defmethod alien-type ((type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + (alien-type 'pointer)) + + (defmethod size-of ((type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + (size-of 'pointer)) + + (defmethod to-alien-form (path (type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + `(%make-tree-path ,path)) + + (defmethod from-alien-form (location (type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + `(let ((location ,location)) + (prog1 + (%tree-path-to-vector location) + (%tree-path-free location)))) + + (defmethod copy-from-alien-form (location (type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + `(%tree-path-to-vector ,location)) + + (defmethod cleanup-form (location (type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + `(%tree-path-free ,location))) + +(defmethod to-alien-function ((type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + #'%make-tree-path) + +(defmethod from-alien-function ((type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + #'(lambda (location) + (prog1 + (%tree-path-to-vector location) + (%tree-path-free location)))) + +(defmethod copy-from-alien-function ((type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + #'%tree-path-to-vector) + +(defmethod cleanup-function ((type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + #'%tree-path-free) + +(defmethod writer-function ((type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + (let ((writer (writer-function 'pointer))) + #'(lambda (path location &optional (offset 0)) + (funcall writer (%make-tree-path path) location offset)))) + +(defmethod reader-function ((type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + (let ((reader (reader-function 'pointer))) + #'(lambda (location &optional (offset 0)) + (%tree-path-to-vector (funcall reader location offset))))) + +(defmethod destroy-function ((type (eql 'tree-path)) &rest args) + (declare (ignore type args)) + (let ((reader (reader-function 'pointer))) + #'(lambda (location &optional (offset 0)) + (%tree-path-free (funcall reader location offset))))) + + +(defbinding %tree-row-reference-new () pointer + (model tree-model) + (path tree-path)) + +(defmethod initialize-instance ((reference tree-row-reference) &key model path) + (setf + (slot-value reference 'location) + (%tree-row-reference-new model path)) + (call-next-method)) + +(defbinding tree-row-reference-get-path () tree-path + (reference tree-row-reference)) + +(defbinding (tree-row-reference-valid-p "gtk_tree_row_reference_valid") () boolean + (reference tree-row-reference)) + + +(defbinding tree-model-get-column-type () gtype ;type-number + (tree-model tree-model) + (index int)) + +(defbinding tree-model-get-iter + (model path &optional (iter (make-instance 'tree-iter))) boolean + (model tree-model) + (iter tree-iter :return) + (path tree-path)) + +(defbinding tree-model-get-path () tree-path + (tree-model tree-model) + (iter tree-iter)) + +(defbinding %tree-model-get-value () nil + (tree-model tree-model) + (iter tree-iter) + (column int) + (gvalue gvalue)) + +(defun tree-model-value (model row column) + (let ((index (column-index model column)) + (iter (etypecase row + (tree-iter row) + (tree-path (multiple-value-bind (valid iter) + (tree-model-get-iter model row) + (if valid + iter + (error "Invalid tree path: ~A" row))))))) + (with-gvalue (gvalue) + (%tree-model-get-value model iter index gvalue)))) + +(defbinding tree-model-iter-next () boolean + (tree-model tree-model) + (iter tree-iter :return)) + +(defbinding tree-model-iter-children + (tree-model parent &optional (iter (make-instance 'tree-iter))) boolean + (tree-model tree-model) + (iter tree-iter :return) + (parent (or null tree-iter))) + +(defbinding (tree-model-iter-has-child-p "gtk_tree_model_iter_has_child") + () boolean + (tree-model tree-model) + (iter tree-iter)) + +(defbinding tree-model-iter-n-children () int + (tree-model tree-model) + (iter tree-iter)) + +(defbinding tree-model-iter-nth-child + (tree-model parent n &optional (iter (make-instance 'tree-iter))) boolean + (tree-model tree-model) + (iter tree-iter :return) + (parent (or null tree-iter)) + (n int)) + +(defbinding tree-model-iter-parent + (tree-model child &optional (iter (make-instance 'tree-iter))) boolean + (tree-model tree-model) + (iter tree-iter :return) + (child tree-iter)) + +(def-callback-marshal %tree-model-foreach-func + (boolean tree-model (path (copy-of tree-path)) (iter (copy-of tree-iter)))) + +(defbinding %tree-model-foreach () nil + (tree-model tree-model) + ((progn %tree-model-foreach-func) callback) + (callback-id unsigned-int)) + +(defun tree-model-foreach (model function) + (with-callback-function (id function) + (%tree-model-foreach model id))) + +(defbinding tree-model-row-changed () nil + (tree-model tree-model) + (path tree-path) + (iter tree-iter)) + +(defbinding tree-model-row-inserted () nil + (tree-model tree-model) + (path tree-path) + (iter tree-iter)) + +(defbinding tree-model-row-has-child-toggled () nil + (tree-model tree-model) + (path tree-path) + (iter tree-iter)) + +(defbinding tree-model-row-deleted () nil + (tree-model tree-model) + (path tree-path) + (iter tree-iter)) + +(defbinding tree-model-rows-reordered () nil + (tree-model tree-model) + (path tree-path) + (iter tree-iter) + (new-order int)) + + +(defun column-types (model columns) + (map 'vector + #'(lambda (column) + (find-type-number (first (mklist column)))) + columns)) + +(defun column-index (model column) + (or + (etypecase column + (number column) + (symbol (position column (object-data model 'column-names))) + (string (position column (object-data model 'column-names) + :test #'string=))) + (error "~A has no column ~S" model column))) + +(defun column-name (model index) + (svref (object-data model 'column-names) index)) + +(defun tree-model-column-value-setter (model column) + (let ((setters (or + (object-data model 'column-setters) + (setf + (object-data model 'column-setters) + (make-array (tree-model-n-columns model) + :initial-element nil))))) + (let ((index (column-index model column))) + (or + (svref setters index) + (setf + (svref setters index) + (let ((setter + (mkbinding (column-setter-name model) + nil (type-of model) 'tree-iter 'int +; (type-from-number (tree-model-get-column-type model index)) + (tree-model-get-column-type model index) + 'int))) + #'(lambda (value iter) + (funcall setter model iter index value -1)))))))) + +(defun tree-model-row-setter (model) + (or + (object-data model 'row-setter) + (progn + ;; This will create any missing column setter + (loop + for i from 0 below (tree-model-n-columns model) + do (tree-model-column-value-setter model i)) + (let ((setters (object-data model 'column-setters))) + (setf + (object-data model 'row-setter) + #'(lambda (row iter) + (map nil #'(lambda (value setter) + (funcall setter value iter)) + row setters))))))) + +(defun (setf tree-model-value) (value model row column) + (let ((iter (etypecase row + (tree-iter row) + (tree-path (multiple-value-bind (valid iter) + (tree-model-get-iter model row) + (if valid + iter + (error "Invalid tree path: ~A" row))))))) + (funcall (tree-model-column-value-setter model column) value iter) + value)) + +(defun (setf tree-model-row-data) (data model iter) + (funcall (tree-model-row-setter model) data iter) + data) + +(defun %tree-model-set (model iter data) + (etypecase data + (vector (setf (tree-model-row-data model iter) data)) + (cons + (loop + as (column value . rest) = data then rest + do (setf (tree-model-value model iter column) value) + while rest)))) + + +;;; Tree Selection + +(def-callback-marshal %tree-selection-func (boolean tree-selection tree-model (path (copy-of tree-path)) (path-currently-selected boolean))) + +(defbinding tree-selection-set-select-function (selection function) nil + (selection tree-selection) + (%tree-selection-func callback) + ((register-callback-function function) unsigned-int) + (user-data-destroy-func callback)) + +(defbinding tree-selection-get-selected + (selection &optional (iter (make-instance 'tree-iter))) boolean + (selection tree-selection) + (nil null) + (iter tree-iter :return)) + +(def-callback-marshal %tree-selection-foreach-func (nil tree-model (path (copy-of tree-path)) (iter (copy-of tree-iter)))) + +(defbinding %tree-selection-selected-foreach () nil + (tree-selection tree-selection) + ((progn %tree-selection-foreach-func) callback) + (callback-id unsigned-int)) + +(defun tree-selection-selected-foreach (selection function) + (with-callback-function (id function) + (%tree-selection-selected-foreach selection id))) + +(defbinding tree-selection-get-selected-rows () (glist tree-path) + (tree-selection tree-selection) + (nil null)) + +(defbinding tree-selection-count-selected-rows () int + (tree-selection tree-selection)) + +(defbinding %tree-selection-select-path () nil + (tree-selection tree-selection) + (tree-path tree-path)) + +(defbinding %tree-selection-unselect-path () nil + (tree-selection tree-selection) + (tree-path tree-path)) + +(defbinding %tree-selection-path-is-selected () boolean + (tree-selection tree-selection) + (tree-path tree-path)) + +(defbinding %tree-selection-select-iter () nil + (tree-selection tree-selection) + (tree-path tree-path)) + +(defbinding %tree-selection-unselect-iter () nil + (tree-selection tree-selection) + (tree-path tree-path)) + +(defbinding %tree-selection-iter-is-selected () boolean + (tree-selection tree-selection) + (tree-path tree-path)) + +(defun tree-selection-select (selection row) + (etypecase row + (tree-path (%tree-selection-select-path selection row)) + (tree-iter (%tree-selection-select-iter selection row)))) + +(defun tree-selection-unselect (selection row) + (etypecase row + (tree-path (%tree-selection-unselect-path selection row)) + (tree-iter (%tree-selection-unselect-iter selection row)))) + +(defun tree-selection-is-selected-p (selection row) + (etypecase row + (tree-path (%tree-selection-path-is-selected selection row)) + (tree-iter (%tree-selection-iter-is-selected selection row)))) + +(defbinding tree-selection-select-all () nil + (tree-selection tree-selection)) + +(defbinding tree-selection-unselect-all () nil + (tree-selection tree-selection)) + +(defbinding tree-selection-select-range () nil + (tree-selection tree-selection) + (start tree-path) + (end tree-path)) + +(defbinding tree-selection-unselect-range () nil + (tree-selection tree-selection) + (start tree-path) + (end tree-path)) + + +;;; Tree Sortable + +(eval-when (:compile-toplevel :load-toplevel :execute) + (define-enum-type sort-column (:default -1) (:unsorted -2)) + (define-enum-type sort-order (:before -1) (:equal 0) (:after 1))) + + +(def-callback-marshal %tree-iter-compare-func + ((or int sort-order) tree-model (a (copy-of tree-iter)) (b (copy-of tree-iter)))) + +(defbinding tree-sortable-sort-column-changed () nil + (sortable tree-sortable)) + +(defbinding %tree-sortable-get-sort-column-id () boolean + (sortable tree-sortable) + (column int :out) + (order sort-type :out)) + +(defun tree-sortable-get-sort-column (sortable) + (multiple-value-bind (special-p column order) + (%tree-sortable-get-sort-column-id sortable) + (values + (if special-p + (int-to-sort-order column) + (column-name sortable column)) + order))) + +(defbinding (tree-sortable-set-sort-column + "gtk_tree_sortable_set_sort_column_id") + (sortable column order) nil + (sortable tree-sortable) + ((etypecase column + ((or integer sort-column) column) + (symbol (column-index sortable column))) + (or sort-column int)) + (order sort-type)) + +(defbinding %tree-sortable-set-sort-func (sortable column function) nil + (sortable tree-sortable) + ((column-index sortable column) int) + (%tree-iter-compare-func callback) + ((register-callback-function function) unsigned-int) + (user-data-destroy-func callback)) + +(defbinding %tree-sortable-set-default-sort-func () nil + (sortable tree-sortable) + (compare-func (or null pointer)) + (callback-id unsigned-int) + (destroy-func (or null pointer))) + +(defun tree-sortable-set-sort-func (sortable column function) + "Sets the comparison function used when sorting to be FUNCTION. If +the current sort column of SORTABLE is the same as COLUMN, +then the model will sort using this function." + (cond + ((and (eq column :default) (not function)) + (%tree-sortable-set-default-sort-func sortable nil 0 nil)) + ((eq column :default) + (%tree-sortable-set-default-sort-func sortable + (callback %tree-iter-compare-func) + (register-callback-function function) + (callback user-data-destroy-func))) + ((%tree-sortable-set-sort-func sortable column function)))) + +(defbinding tree-sortable-has-default-sort-func-p () boolean + (sortable tree-sortable)) ;;; Tree Store (defbinding %tree-store-set-column-types () nil (tree-store tree-store) - (n-columns unsigned-int) - (columns (vector type-number))) + ((length columns) unsigned-int) + (columns (vector gtype))) -(defmethod initialize-instance ((tree-store tree-store) &key columns) +(defmethod initialize-instance ((tree-store tree-store) &key column-types + column-names) (call-next-method) - (%tree-store-set-column-types tree-store (length columns) - (map 'vector #'find-type-number columns))) - + (%tree-store-set-column-types tree-store column-types) + (when column-names + (setf (object-data tree-store 'column-names) column-names))) -(defbinding %tree-store-set-value () nil - (tree-store tree-store) - (tree-iter tree-iter) - (column int) - (value gvalue)) +(defmethod column-setter-name ((tree-store tree-store)) + (declare (ignore tree-store)) + "gtk_tree_store_set") (defbinding tree-store-remove () boolean (tree-store tree-store) (tree-iter tree-iter)) -(defbinding tree-store-insert (tree-store position &optional parent) nil +(defbinding %tree-store-insert () nil (tree-store tree-store) - ((make-instance 'tree-iter) tree-iter :in-out) + (tree-iter tree-iter) (parent (or null tree-iter)) (position int)) -(defbinding tree-store-insert-before (tree-store &optional parent sibling) nil +(defun tree-store-insert + (store parent position &optional data (iter (make-instance 'tree-iter))) + (%tree-store-insert store iter parent position) + (when data (%tree-model-set store iter data)) + iter) + +(defbinding %tree-store-insert-before () nil (tree-store tree-store) - ((make-instance 'tree-iter) tree-iter :in-out) + (tree-iter tree-iter) (parent (or null tree-iter)) (sibling (or null tree-iter))) -(defbinding tree-store-insert-after (tree-store &optional parent sibling) nil +(defun tree-store-insert-before + (store parent sibling &optional data (iter (make-instance 'tree-iter))) + (%tree-store-insert-before store iter parent sibling) + (when data (%tree-model-set store iter data)) + iter) + +(defbinding %tree-store-insert-after () nil (tree-store tree-store) - ((make-instance 'tree-iter) tree-iter :in-out) + (tree-iter tree-iter) (parent (or null tree-iter)) (sibling (or null tree-iter))) -(defbinding tree-store-prepend (tree-store &optional parent) nil +(defun tree-store-insert-after + (store parent sibling &optional data (iter (make-instance 'tree-iter))) + (%tree-store-insert-after store iter parent sibling) + (when data (%tree-model-set store iter data)) + iter) + +(defbinding %tree-store-prepend () nil (tree-store tree-store) - ((make-instance 'tree-iter) tree-iter :in-out) + (tree-iter tree-iter) (parent (or null tree-iter))) -(defbinding tree-store-append (tree-store &optional parent) nil +(defun tree-store-prepend + (store parent &optional data (iter (make-instance 'tree-iter))) + (%tree-store-prepend store iter parent) + (when data (%tree-model-set store iter data)) + iter) + +(defbinding %tree-store-append () nil (tree-store tree-store) - ((make-instance 'tree-iter) tree-iter :in-out) + (tree-iter tree-iter) (parent (or null tree-iter))) +(defun tree-store-append + (store parent &optional data (iter (make-instance 'tree-iter))) + (%tree-store-append store iter parent) + (when data (%tree-model-set store iter data)) + iter) + (defbinding (tree-store-is-ancestor-p "gtk_tree_store_is_ancestor") () boolean (tree-store tree-store) (tree-iter tree-iter) @@ -236,8 +761,13 @@ (defbinding tree-store-move-after () nil ;;; Tree View -(defbinding tree-view-get-selection () tree-selection - (tree-view tree-view)) +(defmethod initialize-instance ((tree-view tree-view) &rest initargs + &key column) + (call-next-method) + (mapc #'(lambda (column) + (tree-view-append-column tree-view column)) + (get-all initargs :column))) + (defbinding tree-view-columns-autosize () nil (tree-view tree-view)) @@ -250,7 +780,7 @@ (defbinding tree-view-remove-column () int (tree-view tree-view) (tree-view-column tree-view-column)) -(defbinding tree-view-insert-column (view columnd position) int +(defbinding tree-view-insert-column (view column position) int (view tree-view) (column tree-view-column) ((if (eq position :end) -1 position) int)) @@ -321,11 +851,11 @@ (defbinding tree-view-collapse-row () nil (tree-view tree-view) (path tree-path)) -(def-callback-marshal %tree-view-mapping-func (nil tree-view tree-path)) +(def-callback-marshal %tree-view-mapping-func (nil tree-view (path (copy-of tree-path)))) (defbinding %tree-view-map-expanded-rows () nil (tree-view tree-view) - ((callback %tree-view-mapping-func) pointer) + ((progn %tree-view-mapping-func) callback) (callback-id unsigned-int)) (defun map-expanded-rows (function tree-view) @@ -350,17 +880,142 @@ (defbinding tree-view-get-cell-area () nil (tree-view tree-view) (path (or null tree-path)) (column (or null tree-view-column)) - ((make-instance 'gdk:rectangle) gdk:rectangle :in-out)) + ((make-instance 'gdk:rectangle) gdk:rectangle :return)) (defbinding tree-view-get-background-area () nil (tree-view tree-view) (path (or null tree-path)) (column (or null tree-view-column)) - ((make-instance 'gdk:rectangle) gdk:rectangle :in-out)) + ((make-instance 'gdk:rectangle) gdk:rectangle :return)) (defbinding tree-view-get-visible-rect () nil (tree-view tree-view) - ((make-instance 'gdk:rectangle) gdk:rectangle :in-out)) + ((make-instance 'gdk:rectangle) gdk:rectangle :return)) ;; and many more functions which we'll add later + +;;;; Icon View + +#+gtk2.6 +(progn + (defbinding icon-view-get-path-at-pos () tree-path + (icon-view icon-view) + (x int) (y int)) + + (def-callback-marshal %icon-view-foreach-func + (nil icon-view (path (copy-of tree-path)))) + + (defbinding %icon-view-selected-foreach () tree-path + (icon-view icon-view) + ((progn %icon-view-foreach-func) callback) + (callback-id unsigned-int)) + + (defun icon-view-foreach (icon-view function) + (with-callback-function (id function) + (%icon-view-selected-foreach icon-view id))) + + (defbinding icon-view-select-path () nil + (icon-view icon-view) + (path tree-path)) + + (defbinding icon-view-unselect-path () nil + (icon-view icon-view) + (path tree-path)) + + (defbinding icon-view-path-is-selected-p () boolean + (icon-view icon-view) + (path tree-path)) + + (defbinding icon-view-get-selected-items () (glist tree-path) + (icon-view icon-view)) + + (defbinding icon-view-select-all () nil + (icon-view icon-view)) + + (defbinding icon-view-unselect-all () nil + (icon-view icon-view)) + + (defbinding icon-view-item-activated () nil + (icon-view icon-view) + (path tree-path)) + + (defbinding %icon-view-set-text-column (column icon-view) nil + (icon-view icon-view) + ((if (integerp column) + column + (column-index (icon-view-model icon-view) column)) int)) + + (defbinding %icon-view-set-markup-column (column icon-view) nil + (icon-view icon-view) + ((if (integerp column) + column + (column-index (icon-view-model icon-view) column)) int)) + + (defbinding %icon-view-set-pixbuf-column (column icon-view) nil + (icon-view icon-view) + ((if (integerp column) + column + (column-index (icon-view-model icon-view) column)) int))) + +#+gtk2.8 +(progn + (defbinding icon-view-get-item-at-pos () boolean + (icon-view icon-view) + (x int) + (y int) + (tree-path tree-path :out) + (cell cell-renderer :out)) + + (defbinding icon-view-set-cursor (icon-view path &key cell start-editing) nil + (icon-view icon-view) + (path tree-path) + (cell (or null cell-renderer)) + (start-editing boolean)) + + (defbinding icon-view-get-cursor () boolean + (icon-view icon-view) + (path tree-path :out) + (cell cell-renderer :out)) + + (defbinding icon-view-get-dest-item-at-pos () boolean + (icon-view icon-view) + (drag-x int) + (drag-y int) + (tree-path tree-path :out) + (pos drop-position :out)) + + (defbinding icon-view-create-drag-icon () gdk:pixmap + (icon-view icon-view) + (tree-path tree-path)) + + (defbinding icon-view-scroll-to-path (icon-view tree-path &key row-align column-align) nil + (icon-view icon-view) + (tree-path tree-path) + ((or row-align column-align) boolean) + (row-align single-float) + (column-align single-float)) + + (defbinding icon-view-get-visible-range () boolean + (icon-view icon-view) + (start-path tree-path :out) + (end-path tree-path :out)) + +;; (defbinding icon-view-enable-model-drag-source () nil +;; (icon-view icon-view) +;; (start-button-mask gdk:modifier-type) +;; (targets (vector target-entry)) +;; ((length targets) unsigned-int) +;; (actions gdk:drag-action)) + +;; (defbinding icon-view-enable-model-drag-dest () nil +;; (icon-view icon-view) +;; (targets (vector target-entry)) +;; ((length targets) unsigned-int) +;; (actions gdk:drag-action)) + + (defbinding icon-view-unset-model-drag-source () nil + (icon-view icon-view)) + + (defbinding icon-view-unset-model-drag-dest () nil + (icon-view icon-view)))