Giter Club home page Giter Club logo

Comments (5)

bohonghuang avatar bohonghuang commented on July 19, 2024 1

I just don't quite understand the purpose of the line (tg:cancel-finalization string-list) in the callback, it seems to work the same without it.

In general, cl-gobject-introspection adds a finalizer for each GObject, allowing Lisp to modify the reference count of the GObject during garbage collection to correctly free memory. However, the caller of TreeListModelCreateModelFunc takes ownership of the returned object. If Lisp tries decreasing the reference count of this object when the caller has already destroyed it during garbage collection, memory issues may occur.

from cl-gtk4.

bohonghuang avatar bohonghuang commented on July 19, 2024

the CFFI callback seems to cause an internal floating point error with SBCL

It's strange that I haven't encountered this situation in my environment, but you can execute the following code before running the GTK application to avoid this problem:

(sb-int:set-floating-point-modes :traps nil)

from cl-gtk4.

bohonghuang avatar bohonghuang commented on July 19, 2024

I also can't figure out how to return a pointer to the child model from the GtkTreeListModelCreateModelFunc callback

The glib::put-object and glib::get-object functions simply utilize the additional parameter of the callback (i.e., a numerical value of a C pointer) to pass arbitrary Lisp objects. The pointers themselves used in these functions are meaningless. I have made some modifications to the example for your reference:

(defstruct product-info
  name cost sale subseries)

(cffi:defcallback tree-list-model-create-model-func :pointer ((item :pointer) (user-data :pointer))
  (destructuring-bind (product-table . build-uuid-string-list)
      (glib::get-object (cffi:pointer-address user-data))
    (if (cffi:null-pointer-p item) (cffi:null-pointer)
        (let* ((uuid (string-object-string (gobj:pointer-object item 'string-object)))
               (product (gethash uuid product-table))
               (string-list (funcall build-uuid-string-list (product-info-subseries product))))
          (tg:cancel-finalization string-list)
          (gobj:object-pointer string-list)))))

(define-application (:name closting :id "com.closting")
  (define-main-window (window (make-application-window :application *application*))
    (let* ((product-table (make-hash-table :test #'equal))
           (build-uuid-string-list (lambda (products)
                                     (loop :for product :in products
                                           :for uuid := (prin1-to-string (uuid:make-v1-uuid))
                                           :do (setf (gethash uuid product-table) product)
                                           :collect uuid :into uuids
                                           :finally (return (gtk:make-string-list :strings uuids)))))
           (root-model (funcall build-uuid-string-list (list (make-product-info :name "iPhone 15"
                                                                                :cost "799$"
                                                                                :sale "899$"
                                                                                :subseries (list (make-product-info
                                                                                                  :name "iPhone 15 Pro"
                                                                                                  :cost "899$"
                                                                                                  :sale "999$")
                                                                                                 (make-product-info
                                                                                                  :name "iPhone 15 Pro Max"
                                                                                                  :cost "1099$"
                                                                                                  :sale "1199$")))
                                                             (make-product-info :name "Infinix S90" :cost "40$" :sale "60$" :subseries nil)
                                                             (make-product-info :name "Casio Calculator" :cost "50$" :sale "80$" :subseries nil))))
           (tree-list-model (make-tree-list-model :root (make-multi-selection :model root-model)
                                                  :passthrough nil
                                                  :autoexpand nil
                                                  :create-func (cffi:callback tree-list-model-create-model-func)
                                                  :user-data (cffi:make-pointer (glib::put-object (cons product-table build-uuid-string-list)))
                                                  :user-destroy (cffi:callback glib::free-object-callback)))
           (column-view (make-column-view :model (make-single-selection :model tree-list-model))))
      (mapc (lambda (name accessor)
              (let* ((factory (make-signal-list-item-factory))
                     (col (make-column-view-column :title name :factory factory)))
                (flet ((setup (factory item) (declare (ignore factory))
                         (let ((expander (make-tree-expander))
                               (label (make-label :str "")))
                           (setf (tree-expander-child expander) label
                                 (list-item-child item) expander)))
                       (bind (factory item) (declare (ignore factory))
                         (let* ((row (gobj:coerce (list-item-item item) 'tree-list-row))
                                (uuid (string-object-string (gobj:coerce (tree-list-row-item row) 'string-object)))
                                (expander (gobj:coerce (list-item-child item) 'tree-expander))
                                (label (gobj:coerce (tree-expander-child expander) 'label)))
                           (when (string= name "Name")
                             (setf (tree-expander-list-row expander) row))
                           (setf (label-text label) (princ-to-string (funcall accessor (gethash uuid product-table)))))))
                  (connect factory "setup" #'setup)
                  (connect factory "bind" #'bind))
                (column-view-append-column column-view col)))
            (list "Name" "Cost" "Sale")
            (list #'product-info-name #'product-info-cost #'product-info-sale))
      (setf (widget-vexpand-p column-view) t
            (widget-hexpand-p column-view) t
            (window-title window) "Closting"
            (window-child window) column-view)
      (unless (widget-visible-p window)
        (window-present window)))))

It appears to be working well:

screenshot

from cl-gtk4.

seigakaku avatar seigakaku commented on July 19, 2024

Your example worked perfectly under both CCL and SBCL, thank you.
I still got the floating point error under SBCL, but running (sb-int:set-floating-point-modes :traps nil) got rid of it.

I just don't quite understand the purpose of the line (tg:cancel-finalization string-list) in the callback, it seems to work the same without it.

from cl-gtk4.

seigakaku avatar seigakaku commented on July 19, 2024

I understand now, thank you for explaining, I'll close the issue now.

from cl-gtk4.

Related Issues (20)

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. 📊📈🎉

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google ❤️ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.