Removed dependency on anaphora and metabang-bind

diff --git a/glib/glib.asd b/glib/glib.asd
index 43fc30c..2454c44 100644 (file)
--- a/glib/glib.asd
+++ b/glib/glib.asd
@@ -27,4 +27,4 @@
                (:file "gobject.generating")
                (:file "gobject.object-defs")
                (:file "gobject.foreign-gobject-subclassing"))
-  :depends-on (:cffi :trivial-garbage :metabang-bind :iterate :anaphora :bordeaux-threads :iterate :closer-mop))
\ No newline at end of file
+  :depends-on (:cffi :trivial-garbage :iterate :bordeaux-threads :iterate :closer-mop))
\ No newline at end of file

diff --git a/glib/gobject.foreign-gboxed.lisp b/glib/gobject.foreign-gboxed.lisp
index abae705..5b201be 100644 (file)
--- a/glib/gobject.foreign-gboxed.lisp
+++ b/glib/gobject.foreign-gboxed.lisp
@@ -106,7 +106,7 @@
       name))
 
 (defun slot->slot-parser (class-name pointer-var slot)
-  (bind (((slot-name slot-type &key parser &allow-other-keys) slot))
+  (destructuring-bind (slot-name slot-type &key parser &allow-other-keys) slot
     (cond
       (parser
        `(setf ,slot-name (funcall ,parser ',class-name ,pointer-var)))
@@ -122,7 +122,7 @@
          ,@(mapcar (lambda (slot) (slot->slot-parser name 'pointer slot)) slots)))))
 
 (defun slot->slot-unparser (class-name pointer-var slot object)
-  (bind (((slot-name slot-type &key unparser &allow-other-keys) slot))
+  (destructuring-bind (slot-name slot-type &key unparser &allow-other-keys) slot
     (cond
       (unparser
        `(funcall ,unparser ',class-name ,pointer-var ,object))
@@ -148,7 +148,7 @@
   (intern (format nil "MAKE-~A" (symbol-name name)) (symbol-package name)))
 
 (defun get-g-boxed-direct-subclasses (name)
-  (mapcar (lambda (spec) (bind (((name slot values) spec))
+  (mapcar (lambda (spec) (destructuring-bind (name slot values) spec
                            (declare (ignore slot values))
                            name))
           (get name 'boxed-dispatch)))
@@ -176,29 +176,30 @@
     (get-g-boxed-completed-c-definition (g-boxed-root name) (get name 'c-name))))
 
 (defmacro define-g-boxed-class (g-name-and-c-name name (&optional superclass-and-dispatch (export t)) &body slots)
-  (bind (((&optional g-name c-name) (ensure-list g-name-and-c-name))
-         ((&optional superclass dispatch-slot dispatch-values) superclass-and-dispatch)
-         (superclass-slots (get superclass 'boxed-combined-slots))
-         (combined-slots (append superclass-slots slots)))
-    (setf c-name (or c-name (gensym "C-UNION-")))
-    `(progn ,(cstruct-definition name combined-slots)
-            ,(struct-definition name superclass slots)
-            ,(parse-method-definition name combined-slots)
-            ,(unparse-method-definition name combined-slots)
-            (eval-when (:load-toplevel :compile-toplevel :execute)
-              (setf (get ',name 'boxed-slots) ',slots
-                    (get ',name 'boxed-combined-slots) ',combined-slots
-                    (get ',name 'superclass) ',superclass
-                    (get ',name 'c-name) (or (get ',name 'c-name) ',c-name))
-              ,@(when superclass
-                      (list `(pushnew '(,name ,dispatch-slot ,(ensure-list dispatch-values)) (get ',superclass 'boxed-dispatch) :test 'equalp))))
-            (update-g-boxed-root-c-class ,name)
-            ,@(when g-name
-                    (list `(register-boxed-type ,g-name ',name)))
-            ,@(when export
-                    (append (list `(export ',name (symbol-package ',name))
-                                  `(export ',(struct-constructor-name name) (symbol-package ',(struct-constructor-name name))))
-                            (mapcar (lambda (slot) (slot->export-accessor name slot)) slots))))))
+  (destructuring-bind (&optional g-name c-name) (ensure-list g-name-and-c-name)
+    (destructuring-bind (&optional superclass dispatch-slot dispatch-values) superclass-and-dispatch
+      (let* ((superclass-slots (get superclass 'boxed-combined-slots))
+             (combined-slots (append superclass-slots slots)))
+        
+        (setf c-name (or c-name (gensym "C-UNION-")))
+        `(progn ,(cstruct-definition name combined-slots)
+                ,(struct-definition name superclass slots)
+                ,(parse-method-definition name combined-slots)
+                ,(unparse-method-definition name combined-slots)
+                (eval-when (:load-toplevel :compile-toplevel :execute)
+                  (setf (get ',name 'boxed-slots) ',slots
+                        (get ',name 'boxed-combined-slots) ',combined-slots
+                        (get ',name 'superclass) ',superclass
+                        (get ',name 'c-name) (or (get ',name 'c-name) ',c-name))
+                  ,@(when superclass
+                          (list `(pushnew '(,name ,dispatch-slot ,(ensure-list dispatch-values)) (get ',superclass 'boxed-dispatch) :test 'equalp))))
+                (update-g-boxed-root-c-class ,name)
+                ,@(when g-name
+                        (list `(register-boxed-type ,g-name ',name)))
+                ,@(when export
+                        (append (list `(export ',name (symbol-package ',name))
+                                      `(export ',(struct-constructor-name name) (symbol-package ',(struct-constructor-name name))))
+                                (mapcar (lambda (slot) (slot->export-accessor name slot)) slots))))))))
 
 (defun boxed-c-structure-name (name)
   (get (g-boxed-root name) 'c-name))
@@ -223,9 +224,10 @@
   (unless (gethash (pointer-address pointer) *boxed-ref-count*)
     (error "g-boxed-ref ~A is already disposed from lisp-side" pointer))
   (with-recursive-lock-held (*g-boxed-gc-lock*)
-    (awhen (gethash (pointer-address pointer) *known-boxed-refs*)
-      (debugf "Removing finalization from ~A for pointer ~A~%" it pointer)
-      (tg:cancel-finalization it))
+    (let ((object (gethash (pointer-address pointer) *known-boxed-refs*)))
+      (when object
+        (debugf "Removing finalization from ~A for pointer ~A~%" object pointer)
+        (tg:cancel-finalization object)))
     (when (eq :lisp (gethash (pointer-address pointer) *boxed-ref-owner*))
       (funcall (boxed-ref-free-function type) pointer))
     (remhash (pointer-address pointer) *known-boxed-refs*)
@@ -238,8 +240,9 @@
 (defmethod initialize-instance :after ((object g-boxed-ref) &key)
   (with-recursive-lock-held (*g-boxed-gc-lock*)
     (let ((address (pointer-address (pointer object))))
-      (awhen (gethash address *known-boxed-refs*)
-        (tg:cancel-finalization it))
+      (let ((object (gethash address *known-boxed-refs*)))
+        (when object
+          (tg:cancel-finalization object)))
       (setf (gethash address *known-boxed-refs*) object)
       (setf (gethash address *boxed-ref-count*) 1)
       (setf (gethash address *boxed-ref-owner*)
@@ -279,15 +282,15 @@
 (defun convert-g-boxed-ref-from-pointer (pointer name type)
   (unless (null-pointer-p pointer)
     (with-recursive-lock-held (*g-boxed-gc-lock*)
-     (or (aprog1 (gethash (pointer-address pointer) *known-boxed-refs*)
-           (when it (debugf "Boxed-ref for ~A is found (~A)~%" pointer it))
-           (when it (incf (gethash (pointer-address pointer) *boxed-ref-count*)))
-           it)
-         (aprog1 (make-instance name :pointer pointer)
-           (setf (gethash (pointer-address pointer) *boxed-ref-owner*) (g-boxed-ref-owner type))
-           (debugf "Boxed-ref for ~A is created (~A) with owner ~A~%" pointer it
-                   (gethash (pointer-address pointer) *boxed-ref-owner*))
-           it)))))
+      (or (let ((object (gethash (pointer-address pointer) *known-boxed-refs*)))
+            (when object (debugf "Boxed-ref for ~A is found (~A)~%" pointer object))
+            (when object (incf (gethash (pointer-address pointer) *boxed-ref-count*)))
+            object)
+          (let ((object (make-instance name :pointer pointer)))
+            (setf (gethash (pointer-address pointer) *boxed-ref-owner*) (g-boxed-ref-owner type))
+            (debugf "Boxed-ref for ~A is created (~A) with owner ~A~%" pointer object
+                    (gethash (pointer-address pointer) *boxed-ref-owner*))
+            object)))))
 
 (defmethod translate-from-foreign (value (type g-boxed-ref-type))
   (let ((owner (or (gethash (pointer-address value) *boxed-ref-owner*) (g-boxed-ref-owner type)))) ;;This is needed to prevent changing ownership of already created
@@ -296,7 +299,7 @@
       (setf (gethash (pointer-address value) *boxed-ref-owner*) owner))))
 
 (defun g-boxed-ref-slot->methods (class slot)
-  (bind (((slot-name &key reader writer type (accessor slot-name)) slot))
+  (destructuring-bind (slot-name &key reader writer type (accessor slot-name)) slot
     `(progn ,@(when reader
                     (list `(defmethod ,accessor ((object ,class))
                              ,(if (stringp reader)

diff --git a/glib/gobject.foreign-gobject-subclassing.lisp b/glib/gobject.foreign-gobject-subclassing.lisp
index 53b424d..b64f451 100644 (file)
--- a/glib/gobject.foreign-gobject-subclassing.lisp
+++ b/glib/gobject.foreign-gobject-subclassing.lisp
@@ -124,12 +124,12 @@
                            (return-from-interface-method-implementation (v) :interactive (lambda () (list (eval (read)))) v)))))))
 
 (defun interface-init (iface data)
-  (bind (((class-name interface-name) (prog1 (get-stable-pointer-value data) (free-stable-pointer data)))
-         (vtable (gethash interface-name *vtables*))
-         (vtable-cstruct (vtable-description-cstruct-name vtable)))
-    (debugf "interface-init for class ~A and interface ~A~%" class-name interface-name)
-    (iter (for method in (vtable-description-methods vtable))
-          (setf (foreign-slot-value iface vtable-cstruct (vtable-method-info-name method)) (get-callback (vtable-method-info-callback-name method))))))
+  (destructuring-bind (class-name interface-name) (prog1 (get-stable-pointer-value data) (free-stable-pointer data))
+    (let* ((vtable (gethash interface-name *vtables*))
+           (vtable-cstruct (vtable-description-cstruct-name vtable)))
+      (debugf "interface-init for class ~A and interface ~A~%" class-name interface-name)
+      (iter (for method in (vtable-description-methods vtable))
+            (setf (foreign-slot-value iface vtable-cstruct (vtable-method-info-name method)) (get-callback (vtable-method-info-callback-name method)))))))
 
 (defcallback c-interface-init :void ((iface :pointer) (data :pointer))
   (interface-init iface data))

diff --git a/glib/gobject.foreign-gobject.lisp b/glib/gobject.foreign-gobject.lisp
index d02bea8..33b8434 100644 (file)
--- a/glib/gobject.foreign-gobject.lisp
+++ b/glib/gobject.foreign-gobject.lisp
@@ -115,9 +115,10 @@
           (gethash (pointer-address pointer) *foreign-gobjects*)
           (gethash (pointer-address pointer) *foreign-gobjects-ref-count*)
           (ref-count pointer))
-  (awhen (gethash (pointer-address pointer) *foreign-gobjects*)
-    (setf (pointer it) nil)
-    (cancel-finalization it))
+  (let ((object (gethash (pointer-address pointer) *foreign-gobjects*)))
+    (when object
+      (setf (pointer object) nil)
+      (cancel-finalization object)))
   (remhash (pointer-address pointer) *foreign-gobjects*)
   (remhash (pointer-address pointer) *foreign-gobjects-ref-count*)
   (g-object-unref pointer))
@@ -175,11 +176,12 @@
 
 (defun get-g-object-for-pointer (pointer)
   (unless (null-pointer-p pointer)
-    (aif (gethash (pointer-address pointer) *foreign-gobjects*)
-         (prog1 it
-           (incf (gethash (pointer-address pointer) *foreign-gobjects-ref-count*))
-           (debugf "increfering object ~A~%" pointer))
-         (make-g-object-from-pointer pointer))))
+    (let ((object (gethash (pointer-address pointer) *foreign-gobjects*)))
+      (if object
+          (prog1 object
+            (incf (gethash (pointer-address pointer) *foreign-gobjects-ref-count*))
+            (debugf "increfering object ~A~%" pointer))
+          (make-g-object-from-pointer pointer)))))
 
 (defmethod translate-from-foreign (pointer (type foreign-g-object-type))
   (get-g-object-for-pointer pointer))

diff --git a/glib/gobject.package.lisp b/glib/gobject.package.lisp
index 40852a5..cbffca7 100644 (file)
--- a/glib/gobject.package.lisp
+++ b/glib/gobject.package.lisp
@@ -1,5 +1,5 @@
 (defpackage :gobject
-  (:use :cl :glib :cffi :tg :bind :anaphora :bordeaux-threads :iter :closer-mop)
+  (:use :cl :glib :cffi :tg :bordeaux-threads :iter :closer-mop)
   (:export #:g-object
            #:register-object-type
            #:g-object-call-constructor

diff --git a/gtk/gtk.asd b/gtk/gtk.asd
index 3654983..b8ca600 100644 (file)
--- a/gtk/gtk.asd
+++ b/gtk/gtk.asd
@@ -54,4 +54,4 @@
                (:file "gtk.dialog.example")
                
                (:file "gtk.demo"))
-  :depends-on (:glib :cffi :gdk :anaphora :bordeaux-threads))
\ No newline at end of file
+  :depends-on (:glib :cffi :gdk :bordeaux-threads))
\ No newline at end of file

diff --git a/gtk/gtk.builder.lisp b/gtk/gtk.builder.lisp
index 659d8af..bcc06d5 100644 (file)
--- a/gtk/gtk.builder.lisp
+++ b/gtk/gtk.builder.lisp
@@ -101,8 +101,9 @@
 (defun builder-connect-signals-simple (builder handlers-list)
   (flet ((connect-func (builder object signal-name handler-name connect-object flags)
            (declare (ignore builder connect-object))
-           (awhen (find handler-name handlers-list :key 'first :test 'string=)
-      (g-signal-connect object signal-name (second it) :after (member :after flags)))))
+           (let ((handler (find handler-name handlers-list :key 'first :test 'string=)))
+             (when handler
+               (g-signal-connect object signal-name (second handler) :after (member :after flags))))))
     (builder-connect-signals-full builder #'connect-func)))
 
 (export 'builder-connect-signals-simple)

diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp
index 57f38b1..8fe99b9 100644 (file)
--- a/gtk/gtk.demo.lisp
+++ b/gtk/gtk.demo.lisp
@@ -1,5 +1,5 @@
 (defpackage :gtk-demo
-  (:use :cl :gtk :gdk :gobject :anaphora :iter)
+  (:use :cl :gtk :gdk :gobject :iter)
   (:export #:test
            #:test-entry
            #:table-packing
@@ -12,7 +12,6 @@
            #:demo-code-editor
            #:test-treeview-list
            #:test-combo-box
-           #:test-toolbar
            #:test-ui-manager
            #:test-color-button
            #:test-color-selection
@@ -393,8 +392,9 @@
             (for action = (make-instance 'action :name name :stock-id stock-id))
             (g-signal-connect action "activate" fn)
             (action-group-add-action action-group action))
-      (awhen (ui-manager-widget ui-manager "/toolbar1")
-        (container-add window it))
+      (let ((widget (ui-manager-widget ui-manager "/toolbar1")))
+        (when widget
+          (container-add window widget)))
       (widget-show window))))
 
 (defun test-color-button ()
@@ -545,8 +545,9 @@
 
 (defun demo-text-editor ()
   (within-main-loop
-    (let* ((builder (aprog1 (make-instance 'builder)
-                      (builder-add-from-file it (namestring (merge-pathnames "demo/text-editor.ui" *src-location*)))))
+    (let* ((builder (let ((builder (make-instance 'builder)))
+                      (builder-add-from-file builder (namestring (merge-pathnames "demo/text-editor.ui" *src-location*)))
+                      builder))
            (window (builder-get-object builder "window1"))
            (text-view (builder-get-object builder "textview1"))
            (status-bar (builder-get-object builder "statusbar1"))

diff --git a/gtk/gtk.package.lisp b/gtk/gtk.package.lisp
index b71d700..15bce8e 100644 (file)
--- a/gtk/gtk.package.lisp
+++ b/gtk/gtk.package.lisp
@@ -1,5 +1,5 @@
 (defpackage :gtk
-  (:use :cl :cffi :gobject :gdk :glib :metabang-bind :anaphora)
+  (:use :cl :cffi :gobject :gdk :glib)
   (:export #:register-object-type
            #:gtk-main
            #:gtk-main-quit

diff --git a/gtk/gtk.text.lisp b/gtk/gtk.text.lisp
index b697e10..716d6b1 100644 (file)
--- a/gtk/gtk.text.lisp
+++ b/gtk/gtk.text.lisp
@@ -596,8 +596,9 @@
   (char-offset :int))
 
 (defun text-buffer-get-iter-at-line-offset (buffer line-number char-offset)
-  (aprog1 (make-instance 'text-iter)
-    (gtk-text-buffer-get-iter-at-line-offset buffer it line-number char-offset)))
+  (let ((iter (make-instance 'text-iter)))
+    (gtk-text-buffer-get-iter-at-line-offset buffer iter line-number char-offset)
+    iter))
 
 (export 'text-buffer-get-iter-at-line-offset)
 
@@ -607,8 +608,9 @@
   (char-offset :int))
 
 (defun text-buffer-get-iter-at-offset (buffer offset)
-  (aprog1 (make-instance 'text-iter)
-    (gtk-text-buffer-get-iter-at-offset buffer it offset)))
+  (let ((iter (make-instance 'text-iter)))
+    (gtk-text-buffer-get-iter-at-offset buffer iter offset)
+    iter))
 
 (export 'text-buffer-get-iter-at-offset)
 
@@ -618,8 +620,9 @@
   (line-number :int))
 
 (defun text-buffer-get-iter-at-line (buffer line-number)
-  (aprog1 (make-instance 'text-iter)
-    (gtk-text-buffer-get-iter-at-line buffer it line-number)))
+  (let ((iter (make-instance 'text-iter)))
+    (gtk-text-buffer-get-iter-at-line buffer iter line-number)
+    iter))
 
 (export 'text-buffet-get-iter-at-line)
 
@@ -631,8 +634,9 @@
 (defun text-buffer-get-iter-at-mark (buffer mark)
   (when (stringp mark)
     (setf mark (text-buffer-get-mark buffer mark)))
-  (aprog1 (make-instance 'text-iter)
-    (gtk-text-buffer-get-iter-at-mark buffer it mark)))
+  (let ((iter (make-instance 'text-iter)))
+    (gtk-text-buffer-get-iter-at-mark buffer iter mark)
+    iter))
 
 (export 'text-buffer-get-iter-at-mark)
 
@@ -642,8 +646,9 @@
   (anchor (g-object text-child-anchor)))
 
 (defun text-buffer-get-iter-at-child-anchor (buffer anchor)
-  (aprog1 (make-instance 'text-iter)
-    (gtk-text-buffer-get-iter-at-child-anchor buffer it anchor)))
+  (let ((iter (make-instance 'text-iter)))
+    (gtk-text-buffer-get-iter-at-child-anchor buffer iter anchor)
+    iter))
 
 (export 'text-buffer-get-iter-at-child-anchor)
 
@@ -652,8 +657,9 @@
   (iter (g-boxed-ref text-iter)))
 
 (defun text-buffer-get-start-iter (buffer)
-  (aprog1 (make-instance 'text-iter)
-    (gtk-text-buffer-get-start-iter buffer it)))
+  (let ((iter (make-instance 'text-iter)))
+    (gtk-text-buffer-get-start-iter buffer iter)
+    iter))
 
 (export 'text-buffer-get-start-iter)
 
@@ -662,8 +668,9 @@
   (iter (g-boxed-ref text-iter)))
 
 (defun text-buffer-get-end-iter (buffer)
-  (aprog1 (make-instance 'text-iter)
-    (gtk-text-buffer-get-end-iter buffer it)))
+  (let ((iter (make-instance 'text-iter)))
+    (gtk-text-buffer-get-end-iter buffer iter)
+    iter))
 
 (export 'text-buffer-get-end-iter)
 
@@ -914,8 +921,9 @@
   (visible-rect (g-boxed-ptr rectangle :in-out)))
 
 (defun text-view-visible-rect (text-view)
-  (aprog1 (make-rectangle :x 0 :y 0 :width 0 :height 0)
-    (gtk-text-view-get-visible-rect text-view it)))
+  (let ((rect (make-rectangle :x 0 :y 0 :width 0 :height 0)))
+    (gtk-text-view-get-visible-rect text-view rect)
+    rect))
 
 (export 'text-view-visible-rect)
 
@@ -925,8 +933,9 @@
   (location (g-boxed-ptr rectangle :in-out)))
 
 (defun text-view-iter-location (text-view iter)
-  (aprog1 (make-rectangle :x 0 :y 0 :width 0 :height 0)
-    (gtk-text-view-get-iter-location text-view iter it)))
+  (let ((rect (make-rectangle :x 0 :y 0 :width 0 :height 0)))
+    (gtk-text-view-get-iter-location text-view iter rect)
+    rect))
 
 (export 'text-view-iter-location)
 

diff --git a/gtk/gtk.tree-model.lisp b/gtk/gtk.tree-model.lisp
index 6a805eb..4ada311 100644 (file)
--- a/gtk/gtk.tree-model.lisp
+++ b/gtk/gtk.tree-model.lisp
@@ -118,9 +118,10 @@
 
 (defmethod tree-model-get-path-impl ((model array-list-store) iter)
   (using* (iter)
-    (anaphora:aprog1 (make-instance 'tree-path)
-      (setf (tree-path-indices anaphora:it) (list (tree-iter-user-data iter)))
-      (disown-boxed-ref anaphora:it))))
+    (let ((path (make-instance 'tree-path)))
+      (setf (tree-path-indices path) (list (tree-iter-user-data iter)))
+      (disown-boxed-ref path)
+      path)))
 
 (defmethod tree-model-iter-has-child-impl ((model array-list-store) iter)
   (release iter)

diff --git a/gtk/gtk.tree-view.lisp b/gtk/gtk.tree-view.lisp
index dedd435..42664e5 100644 (file)
--- a/gtk/gtk.tree-view.lisp
+++ b/gtk/gtk.tree-view.lisp
@@ -191,8 +191,9 @@
   (rectangle (g-boxed-ptr rectangle)))
 
 (defun tree-view-get-cell-area (tree-view path column)
-  (aprog1 (make-rectangle :x 0 :y 0 :width 0 :height 0)
-    (gtk-tree-view-get-cell-area tree-view path column it)))
+  (let ((rect (make-rectangle :x 0 :y 0 :width 0 :height 0)))
+    (gtk-tree-view-get-cell-area tree-view path column rect)
+    rect))
 
 (export 'tree-view-get-cell-area)
 
@@ -203,8 +204,9 @@
   (rectangle (g-boxed-ptr rectangle)))
 
 (defun tree-view-get-background-area (tree-view path column)
-  (aprog1 (make-rectangle :x 0 :y 0 :width 0 :height 0)
-    (gtk-tree-view-get-background-area tree-view path column it)))
+  (let ((rect (make-rectangle :x 0 :y 0 :width 0 :height 0)))
+    (gtk-tree-view-get-background-area tree-view path column rect)
+    rect))
 
 (export 'tree-view-get-background-area)
 
@@ -213,8 +215,9 @@
   (rectangle (g-boxed-ptr rectangle)))
 
 (defun tree-view-get-visible-rect (tree-view)
-  (aprog1 (make-rectangle :x 0 :y 0 :width 0 :height 0)
-    (gtk-tree-view-get-visible-rect tree-view it)))
+  (let ((rect (make-rectangle :x 0 :y 0 :width 0 :height 0)))
+    (gtk-tree-view-get-visible-rect tree-view rect)
+    rect))
 
 (export 'tree-view-get-visible-rect)
 

diff --git a/subtest.lisp b/subtest.lisp
index 4978b8a..c422022 100644 (file)
--- a/subtest.lisp
+++ b/subtest.lisp
@@ -142,9 +142,10 @@
 
 (defmethod tree-model-get-path-impl ((model array-list-store) iter)
   (gobject:using* (iter)
-    (anaphora:aprog1 (make-instance 'tree-path)
-      (setf (tree-path-indices anaphora:it) (list (tree-iter-user-data iter)))
-      (gobject:disown-boxed-ref anaphora:it))))
+    (let ((path (make-instance 'tree-path)))
+      (setf (tree-path-indices path) (list (tree-iter-user-data iter)))
+      (gobject:disown-boxed-ref path)
+      path)))
 
 (defmethod tree-model-iter-has-child-impl ((model array-list-store) iter)
   (gobject:release iter)