From 81a8bbf4785f9f7473dccfce5f5d2318f2ac0452 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Wed, 9 Sep 2009 22:55:54 +0400 Subject: [PATCH] Some more sophistication in mm-test --- mm-test.lisp | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/mm-test.lisp b/mm-test.lisp index e76ae5d..d152bc5 100644 --- a/mm-test.lisp +++ b/mm-test.lisp @@ -6,6 +6,11 @@ (in-package :mm-test) +(defun get-object (ptr) + (when (cffi:pointerp ptr) (setf ptr (cffi:pointer-address ptr))) + (or (gethash ptr gobject::*foreign-gobjects-strong*) + (gethash ptr gobject::*foreign-gobjects-weak*))) + (defun do-gc () (gc :full t) (gobject::activate-gc-hooks) @@ -16,10 +21,16 @@ (gobject::activate-gc-hooks) (gc :full t)) +(defun object-handlers (object) + (when object + (remove nil (gobject::g-object-signal-handlers object)))) + (defun print-refs-table (table &optional (stream *standard-output*)) (iter (for (ptr object) in-hashtable table) - (format stream "~A => ~A (~A refs)~%" - ptr object (gobject::ref-count object)))) + (format stream "~A => ~A (~A refs~@[~*, floating~])~@[ handlers: ~A~]~%" + ptr object (gobject::ref-count object) + (gobject.ffi:g-object-is-floating (cffi:make-pointer ptr)) + (object-handlers object)))) (defun print-refs (&optional (stream *standard-output*)) (format stream "Strong:~%") @@ -135,3 +146,16 @@ (gc :full t) (gobject::activate-gc-hooks)) nil)) + +(defun make-builder (&optional return) + (let* ((builder (make-instance 'gtk:builder + :from-file (namestring (merge-pathnames "demo/demo1.ui" gtk-demo::*src-location*)))) + (text-view (builder-get-object builder "textview1")) + (window (builder-get-object builder "window1"))) + (builder-connect-signals-simple + builder + `(("quit_cb" + ,(lambda (&rest args) + (print args) + (object-destroy window))))) + (when return builder))) -- 2.11.4.GIT