Using a List-store - Githubissues

I need to use a list store in my program, but there is no demo of that and I cannot figure it out from the API and the error messages I'm getting. How do I pass the list of columns (I'm assuming that's via the :type keyword, but when I try different things, I get the following error:

The value STRING is not of type (UNSIGNED-BYTE 64)

Please refer to #19.

Thank you, through extensive trial and error, I was able to work it out. I do still need to figure out how to display a color in one of the columns, but I'll work it out on my own.

Ok, I've looked through that more, but I'm trying now to figure out how to make this list-store sortable by columns. So that I could, for example, sort them from most to least expensive. It'd be even better if there were some easy way to search them. Is that possible within GTK or do I need to write some code that will filter out the model? How do I do that without recreating the whole string-list every time (since the UUIDs are unique every time they're generated, not tied to the data itself).

Ok, I've looked through that more, but I'm trying now to figure out how to make this list-store sortable by columns. So that I could, for example, sort them from most to least expensive. It'd be even better if there were some easy way to search them. Is that possible within GTK or do I need to write some code that will filter out the model? How do I do that without recreating the whole string-list every time (since the UUIDs are unique every time they're generated, not tied to the data itself).

Since the list is stored in foreign memory, you need to sort it with GTK's APIs. For example, you can use the SortListModel.

So if I'm understanding what I'm reading in the API correctly, I need to get my CLOS class into the Gobject system somehow (or I need to map the slots of my class to appropriate Gobject types). But this was what I couldn't figure out at the beginning of this.

Let's say I've got a CLOS class that has a name (string), an attack (string), and a point value (int). What do I do to get that into a SortListModel?

I am still contemplating on how to solve this problem more elegantly. Here is my current code, and I apologize for its lack of conciseness. However, you can give it a try to see if it meets your requirements.

(defstruct product-info
  name cost sale)

(cffi:defcallback compare-string-object-via-accessor :int
    ((a :pointer)
     (b :pointer)
     (data :pointer))
  (let ((accessor (gethash (cffi:pointer-address data) glib::*objects*))) ; Use (glib::get-object (cffi:pointer-address data)) in the latest version of cl-glib.
    (let ((string-a (funcall accessor (gtk:string-object-string (gobj:pointer-object a 'gtk:string-object))))
          (string-b (funcall accessor (gtk:string-object-string (gobj:pointer-object b 'gtk:string-object)))))
      (if (string< string-a string-b) +1 -1))))

(cffi:defcallback compare-string-number-object-via-accessor :int
    ((a :pointer)
     (b :pointer)
     (data :pointer))
  (let ((accessor (gethash (cffi:pointer-address data) glib::*objects*))) ; Use (glib::get-object (cffi:pointer-address data)) in the latest version of cl-glib.
    (let ((number-a (funcall accessor (gtk:string-object-string (gobj:pointer-object a 'gtk:string-object))))
          (number-b (funcall accessor (gtk:string-object-string (gobj:pointer-object b 'gtk:string-object)))))
      (if (< number-a number-b) +1 -1))))

(gtk:define-application (:name closting
                         :id "com.closting")
  (gtk:define-main-window (window (gtk:make-application-window :application gtk:*application*))
    (setf (gtk:window-title window) "Closting")
    (let ((product-table (make-hash-table :test #'equal)))
      (let* ((rows (loop :for (name cost sale) :in '(("HP Zbook 15" "250$" "300$")
                                                     ("Infinix S90" "40$" "60$")
                                                     ("Casio Calculator" "50$" "80$"))
                         :for product-info := (make-product-info :name name :cost cost :sale sale)
                         :for uuid := (prin1-to-string (uuid:make-v1-uuid))
                         :do (setf (gethash uuid product-table) product-info)
                         :collect uuid))
             (main-model (gtk:make-string-list :strings rows))
             (column-view (gtk:make-column-view :model nil))
             (col1-factory (gtk:make-signal-list-item-factory))
             (col1 (gtk:make-column-view-column :title "First Col!" :factory col1-factory))
             (col2-factory (gtk:make-signal-list-item-factory))
             (col2 (gtk:make-column-view-column :title "Second Col!" :factory col2-factory))
             (col3-factory (gtk:make-signal-list-item-factory))
             (col3 (gtk:make-column-view-column :title "Third Col!" :factory col3-factory)))
        (setf (gtk:column-view-column-sorter col1) (make-custom-sorter :sort-func (cffi:callback compare-string-object-via-accessor)
                                                                       :user-data (cffi:make-pointer
                                                                                   (glib::put-object
                                                                                    (alexandria:compose
                                                                                     #'product-info-name
                                                                                     (alexandria:rcurry
                                                                                      #'gethash product-table))))
                                                                       :user-destroy (cffi:callback glib::free-object-callback))
              (gtk:column-view-column-sorter col2) (make-custom-sorter :sort-func (cffi:callback compare-string-number-object-via-accessor)
                                                                       :user-data (cffi:make-pointer
                                                                                   (glib::put-object
                                                                                    (alexandria:compose
                                                                                     #'parse-integer
                                                                                     (alexandria:curry
                                                                                      #'string-trim "$")
                                                                                     #'product-info-cost
                                                                                     (alexandria:rcurry
                                                                                      #'gethash product-table))))
                                                                       :user-destroy (cffi:callback glib::free-object-callback))
              (gtk:column-view-column-sorter col3) (make-custom-sorter :sort-func (cffi:callback compare-string-number-object-via-accessor)
                                                                       :user-data (cffi:make-pointer
                                                                                   (glib::put-object
                                                                                    (alexandria:compose
                                                                                     #'parse-integer
                                                                                     (alexandria:curry
                                                                                      #'string-trim "$")
                                                                                     #'product-info-sale
                                                                                     (alexandria:rcurry
                                                                                      #'gethash product-table))))
                                                                       :user-destroy (cffi:callback glib::free-object-callback)))
        (gtk:column-view-append-column column-view col1)
        (gtk:column-view-append-column column-view col2)
        (gtk:column-view-append-column column-view col3)
        (setf (gtk:column-view-model column-view) (make-single-selection :model (gtk:make-sort-list-model :model main-model :sorter (column-view-sorter column-view))))
        (setf (gtk:widget-vexpand-p column-view) t
              (gtk:widget-hexpand-p column-view) t)
        (flet ((setup (factory item)
                 (declare (ignore factory))
                 (setf (gtk:list-item-child item) (gtk:make-label :str "")))
               (unbind (factory item) (declare (ignore factory item)))
               (teardown (factory item) (declare (ignore factory item))))
          (loop :for factory :in (list col1-factory col2-factory col3-factory)
                :for accessor :in (list #'product-info-name #'product-info-cost #'product-info-sale)
                :do (gtk:connect factory "setup" #'setup)
                    (gtk:connect factory "unbind" #'unbind)
                    (gtk:connect factory "teardown" #'teardown)
                    (gtk:connect factory "bind"
                                 (let ((accessor accessor))
                                   (lambda (factory item) 
                                     (declare (ignore factory))
                                     (let* ((uuid (gtk:string-object-string (gobj:coerce (gtk:list-item-item item) 'gtk:string-object)))
                                            (row (gethash uuid product-table)))
                                       (setf (gtk:label-text (gobj:coerce (gtk:list-item-child item) 'gtk:label)) (funcall accessor row))))))))
        (setf (gtk:window-child window) column-view)))
    (unless (gtk:widget-visible-p window)
      (gtk:window-present window))))

A couple clarifying questions here.

When you say the list is "stored in foreign memory", do you mean foreign to Common lisp (that is, in an array of GObjects or something) or foreign to GTK (that is, stored a hash-table in Common Lisp).
Would pursuing the tutorial here be likely to make the code you just posted simpler?
In the compare-string-number-object, I don't see where it gets turned into a number. Is that happening on the C side before it sends it over?

Apologies for all these questions!

1. When you say the list is "stored in foreign memory", do you mean foreign to Common lisp (that is, in an array of GObjects or something) or foreign to GTK (that is, stored a hash-table in Common Lisp).

Lisp interacts with GTK through CFFI, and the memory allocated and accessed via CFFI is known as foreign memory. Foreign memory is not managed by the garbage collector and therefore cannot store Lisp objects such as lists, CLOS objects, and so on. General Lisp methods cannot be applied to foreign objects, and foreign functions cannot access Lisp objects. In my code, the UUID scheme I used involves using C strings to facilitate data exchange between Lisp and foreign memory. In foreign memory, only references to Lisp objects (i.e., UUIDs) are stored. Then, in the factory's signal, these UUIDs are used to retrieve various properties of Lisp objects through a hash table.

2. Would pursuing the tutorial [here](https://github.com/ToshioCP/Gobject-tutorial/blob/main/gfm/sec3.md) be likely to make the code you just posted simpler?

No, it won't. As you can see, I have used some CFFI functions and internal Glib functions in the code. When I mentioned lack of conciseness, I meant that the code is not as "Lispy" as it could be. However, I still believe it is more concise compared to the C version.

3. In the compare-string-number-object, I don't see where it gets turned into a number. Is that happening on the C side before it sends it over?

Here are two techniques being used here:

The use of glib::put-object and glib::get-object to identify Lisp objects as 64-bit integers (CFFI pointers) for passing to the callback.
Passing a function, composed by compose and (r)curry, as a Lisp object to the callback. For example, this function retrieves the price integer via the product UUID.

(alexandria:compose
  #'parse-integer
  (alexandria:curry
   #'string-trim "$")
  #'product-info-sale
  (alexandria:rcurry
   #'gethash product-table))

Ok, fantastic. That is what I thought was happening, but I confused myself. Now this is starting to make more sense. I really appreciate the explanation and example codes and once I've got the model working, I'm happy to strip it down a bit and contribute it back as an example you can include. I'll also write up something you could use in a project wiki (if you want to start one) or I'll write it up on my Github pages so you can point people to it

I'll go back to work with this and see how far it carries me!

Ok, fantastic. That is what I thought was happening, but I confused myself. Now this is starting to make more sense. I really appreciate the explanation and example codes and once I've got the model working, I'm happy to strip it down a bit and contribute it back as an example you can include. I'll also write up something you could use in a project wiki (if you want to start one) or I'll write it up on my Github pages so you can point people to it

I'll go back to work with this and see how far it carries me!

Great, thank you.

I've been trying to make this work and I'm getting an "Unhandled Memory Fault" error that I do not know how to troubleshoot. Here is the minimal example that produces the error.

;; Callback function to compare strings
(cffi:defcallback compare-string-object-via-accessor :int
    ((a :pointer)
     (b :pointer)
     (data :pointer))
  (let ((accessor (gethash (cffi:pointer-address data) glib::*objects*))) ; Use (glib::get-object (cffi:pointer-address data)) in the latest version of cl-glib.
    (let ((string-a (funcall accessor (gtk:string-object-string (gobj:pointer-object a 'gtk:string-object))))
          (string-b (funcall accessor (gtk:string-object-string (gobj:pointer-object b 'gtk:string-object)))))
      (if (string< string-a string-b) +1 -1))))

;; Callback function to compare numbers
(cffi:defcallback compare-string-number-object-via-accessor :int
    ((a :pointer)
     (b :pointer)
     (data :pointer))
  (let ((accessor (gethash (cffi:pointer-address data) glib::*objects*))) ; Use (glib::get-object (cffi:pointer-address data)) in the latest version of cl-glib.
    (let ((number-a (funcall accessor (gtk:string-object-string (gobj:pointer-object a 'gtk:string-object))))
          (number-b (funcall accessor (gtk:string-object-string (gobj:pointer-object b 'gtk:string-object)))))
      (if (< number-a number-b) +1 -1))))

(defun mul-list-view ()
  (let* ((model (gtk:make-string-list :strings (loop for uuid being the hash-keys of *mul*
                                                     :collect uuid)))
         (view (gtk:make-column-view :model (gtk:make-single-selection :model model)))
         (chassis-factory (gtk:make-signal-list-item-factory))
         (chassis-col (gtk:make-column-view-column :title "Chassis" :factory chassis-factory)))
    (setf (gtk:column-view-column-sorter chassis-col) (gtk:make-custom-sorter
                                                       :sort-func (cffi:callback compare-string-object-via-accessor)
                                                       :user-data (cffi:make-pointer (glib::put-object (alexandria:compose #'mek/full-name (alexandria:rcurry #'gethash *mul*))))
                                                       :user-destroy (cffi:callback glib::free-object-callback)))
    (setf (gtk:column-view-model view)
          (gtk:make-single-selection :model (gtk:make-sort-list-model :model model :sorter (gtk:column-view-sorter view))))
    (gtk:column-view-append-column view chassis-col)
    (setf (gtk:widget-hexpand-p view) t
          (gtk:widget-vexpand-p view) t)
    (flet ((setup (factory item)
             (declare (ignore factory))
             (setf (gtk:list-item-child item) (gtk:make-label :str "")))
           (unbind (factory item) (declare (ignore factory item)))
           (teardown (factory item) (declare (ignore factory item))))
      (loop :for factory in (list chassis-factory)
            :for accessor in (list #'mek/full-name)
            :do (gtk:connect factory "setup" #'setup)
                (gtk:connect factory "unbind" #'unbind)
                (gtk:connect factory "teardown" #'teardown)
                (gtk:connect factory "bind"
                             (let ((accessor accessor))
                               (lambda (factory item)
                                 (declare (ignore factory))
                                 (let* ((uuid (gtk:string-object-string (gobj:coerce (gtk:list-item-item item) 'gtk:string-object)))
                                        (row (gethash uuid *mul*))
                                        (value (format nil "~a" (funcall accessor row))))
                                   (setf (gtk:label-text (gobj:coerce (gtk:list-item-child item) 'gtk:label)) value)))))))
    view))

And the error message:

Unhandled memory fault at #x7F4D14C0EAE6.
   [Condition of type SB-SYS:MEMORY-FAULT-ERROR]

Restarts:
 0: [RETURN] Return from current handler.
 1: [RETURN-AND-ABORT] Return from current handler and abort the GTK application.
 2: [RETURN-VALUE] Return from current handler with specified value.
 3: [RETURN-VALUE-AND-ABORT] Return from current handler with specified value and abort the GTK application.
 4: [RETRY] Retry SLY mREPL evaluation request.
 5: [*ABORT] Return to SLY's top level.
 --more--

Backtrace:
 0: (SB-SYS:MEMORY-FAULT-ERROR #<unused argument> #.(SB-SYS:INT-SAP #X7F4D14C0EAE6))
 1: ("foreign function: call_into_lisp_")
 2: ("foreign function: funcall2")
 3: ("foreign function: handle_memory_fault_emulation_trap")
 4: ("foreign function: #x561536E0F431")
 5: ((LAMBDA (&REST GIR::ARGS-IN) :IN GIR::BUILD-FUNCTION) #.(SB-SYS:INT-SAP #X7F4AE0400B40))
 6: ((LAMBDA (GTK4::APP) :IN BENNETT.MEGASTRIKE.MAIN) #<unused argument>)
 7: ((LAMBDA (&REST GTK4::ARGS) :IN GTK4::ATTACH-RESTARTS) #<GIR::OBJECT-INSTANCE {1005D05D33}>)
 8: ((LAMBDA (GIR::CLOSURE RETURN GIR::N-VALUES GIR::PARAMS GIR::HINT GIR::DATA) :IN "/home/jonathanb/.roswell/lisp/quicklisp/dists/quicklisp/software/cl-gobject-introspection-20230618-git/src/signal.lisp..
 9: ((LAMBDA (SB-ALIEN::ARGS-POINTER SB-ALIEN::RESULT-POINTER FUNCTION) :IN "/home/jonathanb/.roswell/lisp/quicklisp/dists/quicklisp/software/cl-gobject-introspection-20230618-git/src/signal.lisp") #<unav..
10: ("foreign function: funcall_alien_callback")
11: ("foreign function: #x50000D8B")
12: ((LAMBDA (&REST GIR::ARGS-IN) :IN GIR::BUILD-FUNCTION) #.(SB-SYS:INT-SAP #X7F4AE0047090) NIL)
13: (GIO:APPLICATION-RUN #<GIR::OBJECT-INSTANCE {1005A59773}> NIL)
14: (SB-INT:SIMPLE-EVAL-IN-LEXENV (MEGASTRIKE) #<NULL-LEXENV>)
15: (EVAL (MEGASTRIKE))
16: ((LAMBDA NIL :IN SLYNK-MREPL::MREPL-EVAL-1))
 --more--

I'm sorry, I couldn't reproduce your issue. Due to the incomplete code you provided, I made some modifications to make it runnable. Here is the code I used, and it appears to be working correctly:

;; Callback function to compare strings
(cffi:defcallback compare-string-object-via-accessor :int
    ((a :pointer)
     (b :pointer)
     (data :pointer))
  (let ((accessor (gethash (cffi:pointer-address data) glib::*objects*))) ; Use (glib::get-object (cffi:pointer-address data)) in the latest version of cl-glib.
    (let ((string-a (funcall accessor (gtk:string-object-string (gobj:pointer-object a 'gtk:string-object))))
          (string-b (funcall accessor (gtk:string-object-string (gobj:pointer-object b 'gtk:string-object)))))
      (if (string< string-a string-b) +1 -1))))

;; Callback function to compare numbers
(cffi:defcallback compare-string-number-object-via-accessor :int
    ((a :pointer)
     (b :pointer)
     (data :pointer))
  (let ((accessor (gethash (cffi:pointer-address data) glib::*objects*))) ; Use (glib::get-object (cffi:pointer-address data)) in the latest version of cl-glib.
    (let ((number-a (funcall accessor (gtk:string-object-string (gobj:pointer-object a 'gtk:string-object))))
          (number-b (funcall accessor (gtk:string-object-string (gobj:pointer-object b 'gtk:string-object)))))
      (if (< number-a number-b) +1 -1))))

(defparameter *mul* (make-hash-table))

(defun mul-list-view ()
  (let* ((model (gtk:make-string-list :strings (loop for uuid being the hash-keys of *mul*
                                                     :collect uuid)))
         (view (gtk:make-column-view :model (gtk:make-single-selection :model model)))
         (chassis-factory (gtk:make-signal-list-item-factory))
         (chassis-col (gtk:make-column-view-column :title "Chassis" :factory chassis-factory)))
    (setf (gtk:column-view-column-sorter chassis-col) (gtk:make-custom-sorter
                                                       :sort-func (cffi:callback compare-string-object-via-accessor)
                                                       :user-data (cffi:make-pointer (glib::put-object (alexandria:compose
                                                                                                        #'princ-to-string
                                                                                                        (alexandria:rcurry #'gethash *mul*))))
                                                       :user-destroy (cffi:callback glib::free-object-callback)))
    (setf (gtk:column-view-model view)
          (gtk:make-single-selection :model (gtk:make-sort-list-model :model model :sorter (gtk:column-view-sorter view))))
    (gtk:column-view-append-column view chassis-col)
    (setf (gtk:widget-hexpand-p view) t
          (gtk:widget-vexpand-p view) t)
    (flet ((setup (factory item)
             (declare (ignore factory))
             (setf (gtk:list-item-child item) (gtk:make-label :str "")))
           (unbind (factory item) (declare (ignore factory item)))
           (teardown (factory item) (declare (ignore factory item))))
      (loop :for factory in (list chassis-factory)
            :for accessor in (list #'princ-to-string)
            :do (gtk:connect factory "setup" #'setup)
                (gtk:connect factory "unbind" #'unbind)
                (gtk:connect factory "teardown" #'teardown)
                (gtk:connect factory "bind"
                             (let ((accessor accessor))
                               (lambda (factory item)
                                 (declare (ignore factory))
                                 (let* ((uuid (gtk:string-object-string (gobj:coerce (gtk:list-item-item item) 'gtk:string-object)))
                                        (row (gethash uuid *mul*))
                                        (value (format nil "~a" (funcall accessor row))))
                                   (setf (gtk:label-text (gobj:coerce (gtk:list-item-child item) 'gtk:label)) value)))))))
    view))

(gtk:define-application (:name issue-25
                     :id "org.bohonghuang.cl-gtk4.issues-25")
  (gtk:define-main-window (window (gtk:make-application-window :application gtk:*application*))
    (setf *mul* (make-hash-table :test #'equal))
    (loop :for i :from 1 :to 10
          :do (setf (gethash (princ-to-string (uuid:make-v1-uuid)) *mul*) (format nil "Element ~A" i)))
    (let ((view (mul-list-view)))
      (setf (gtk:window-child window) view
            (gtk:window-default-size window) '(300 300)))
    (unless (gtk:widget-visible-p window)
      (gtk:window-present window))))

Alright, I reproduced your issue on SBCL.

It appears that the error occurred because you transferred ownership of model for the second time. Both make-column-view and (setf (gtk:column-view-model view)) result in the transfer of ownership of model, causing a double-free issue within GTK internals that cannot be caught in Lisp. To resolve this error, you simply need to modify (gtk:make-column-view :model (gtk:make-single-selection :model model)) to (gtk:make-column-view :model nil).

Here is a working version of your code:

(cffi:defcallback compare-string-object-via-accessor :int
    ((a :pointer)
     (b :pointer)
     (data :pointer))
  (let ((accessor (gethash (cffi:pointer-address data) glib::*objects*))) ; Use (glib::get-object (cffi:pointer-address data)) in the latest version of cl-glib.
    (let ((string-a (funcall accessor (gtk:string-object-string (gobj:pointer-object a 'gtk:string-object))))
          (string-b (funcall accessor (gtk:string-object-string (gobj:pointer-object b 'gtk:string-object)))))
      (if (string< string-a string-b) +1 -1))))

(cffi:defcallback compare-string-number-object-via-accessor :int
    ((a :pointer)
     (b :pointer)
     (data :pointer))
  (let ((accessor (gethash (cffi:pointer-address data) glib::*objects*))) ; Use (glib::get-object (cffi:pointer-address data)) in the latest version of cl-glib.
    (let ((number-a (funcall accessor (gtk:string-object-string (gobj:pointer-object a 'gtk:string-object))))
          (number-b (funcall accessor (gtk:string-object-string (gobj:pointer-object b 'gtk:string-object)))))
      (if (< number-a number-b) +1 -1))))

(defparameter *mul* (make-hash-table :test #'equal))

(defun mul-list-view ()
  (let* ((model (gtk:make-string-list :strings (loop :for uuid :being :the hash-keys :of *mul* :collect uuid)))
         (view (gtk:make-column-view :model nil))
         (chassis-factory (gtk:make-signal-list-item-factory))
         (chassis-col (gtk:make-column-view-column :title "Chassis" :factory chassis-factory)))
    (setf (gtk:column-view-column-sorter chassis-col) (gtk:make-custom-sorter :sort-func (cffi:callback compare-string-object-via-accessor)
                                                                       :user-data (cffi:make-pointer
                                                                                   (glib::put-object
                                                                                    (alexandria:rcurry
                                                                                     #'gethash *mul*)))
                                                                       :user-destroy (cffi:callback glib::free-object-callback)))
    (gtk:column-view-append-column view chassis-col)
    (setf (gtk:column-view-model view) (gtk:make-single-selection :model (gtk:make-sort-list-model :model model :sorter (gtk:column-view-sorter view))))
    (setf (gtk:widget-vexpand-p view) t
          (gtk:widget-hexpand-p view) t)
    (flet ((setup (factory item)
             (declare (ignore factory))
             (setf (gtk:list-item-child item) (gtk:make-label :str "")))
           (unbind (factory item) (declare (ignore factory item)))
           (teardown (factory item) (declare (ignore factory item))))
      (loop :for factory :in (list chassis-factory)
            :for accessor :in (list #'princ-to-string)
            :do (gtk:connect factory "setup" #'setup)
                (gtk:connect factory "unbind" #'unbind)
                (gtk:connect factory "teardown" #'teardown)
                (gtk:connect factory "bind"
                             (let ((accessor accessor))
                               (lambda (factory item) 
                                 (declare (ignore factory))
                                 (let* ((uuid (gtk:string-object-string (gobj:coerce (gtk:list-item-item item) 'gtk:string-object)))
                                        (row (gethash uuid *mul*)))
                                   (setf (gtk:label-text (gobj:coerce (gtk:list-item-child item) 'gtk:label)) (funcall accessor row))))))))
    view))

(gtk:define-application (:name issue-25
                         :id "org.bohonghuang.cl-gtk4.issue-25")
  (gtk:define-main-window (window (gtk:make-application-window :application gtk:*application*))
    (setf *mul* (make-hash-table :test #'equal))
    (loop :for i :from 1 :to 10
          :do (setf (gethash (princ-to-string (uuid:make-v1-uuid)) *mul*) (format nil "Element ~A" i)))
    (setf (gtk:window-title window) "List Model Test"
          (gtk:window-child window) (mul-list-view))
    (unless (gtk:widget-visible-p window)
      (gtk:window-present window))))

Ok, I have that working. Now for the final piece. What if I need to filter the model as well using a Common Lisp function like MEMBER (as in there's a list of codes like "BM", "PM", "BA" ,"CI", etc which can be accessed using mek/type and I want to see all the objects in the list store whose codes are either "BA" or "CI" and then still be able to sort them?).

I see FilterListModel. I'm wondering how I can use that AND sort at the same time since it looks like I'd need to set both of them as the model for the column-view.

EDIT: Ok, I have done some searching and I think I might have something that might work, I just want to see if it seems correct.

1) Write a callback function like this which my CustomFilter can use:

(cffi:defcallback filter-string-object-via-accessor :bool
    ((item :pointer)
     (data :pointer))
  (let ((filter-func (gethash (cffi:pointer-address data) glib::*objects*)))
    (funcall filter-func (gtk:string-object-string (gobj:pointer-object a 'gtk:string-object)))))

Then when i set the model for the column view, I set it like this:

    (setf (gtk:column-view-model view)
          (gtk:make-single-selection :model (gtk:make-sort-list-model :model (gtk:make-filter-list-model :model model :filter filter) :sorter (gtk:column-view-sorter view))))

Where I'm falling down is figuring out how to compose the filter-func that does the filtering. That's because sometimes I'm going to need to filter by MEMBER, sometimes by FIND (like if I'm looking for a unit whose name contains a given string) and sometimes by some math operator (all units that cost less than 35 points).

But I believe once I have done that, I simply put that partially composed function into a variable (filter-func, perhaps) and then call (gtk:filter-changed filter) and my view will update.

Does that all make sense?

Yes, however, you can achieve this without using global variables. Please note that the filter-func passed to the callback can be any object, such as a struct object containing a function or a cons. Therefore, after modifying the field of this struct (i.e., the filter function), you can call the changed method to apply your filter.

I'm unable to find the correct name for GTK_FILTER_CHANGE_DIFFERENT in Common Lisp. Sly isn't giving it to me via autocompletion despite following the pattern in the introspection table (I don't have the link handy). This is the second argument required for gtk:filter-changed

I'm unable to find the correct name for GTK_FILTER_CHANGE_DIFFERENT in Common Lisp.

It is called gtk:+filter-change-different+.

I thought it was final, but I've got one thing left: Selection. How can I save the object associated with the row the user has clicked on into a variable for use later? What does the signal look like?

Here is my first attempt at the signal, it is telling me that I have the wrong number of arguments:

;; forces-view is the column-view which is tied to the model
;; game/selected-force *game* get the object that's managing the game I'm trying to build
;; game/forces-hash *game* is the hash-table that's being used to populate this particular StringListStore
      (gtk:connect (gtk:column-view-model forces-view) "selection-changed"
                     (lambda (model position n-items data)
                       (declare (ignore model position n-items data))
                       (setf (game/selected-force *game*)
                             (gethash (gtk:single-selection-selected-item (gtk:column-view-model forces-view)) (game/forces-hash *game*)))
                       (format t "~a" (game/selected-force *game*))))

I have figured it out! I post here the final version of the signal for selection. We can close this issue at your leisure. Thank you so much for your help! When I am in a position to write this up into something more digestible, how would you like me to send it to you?

;; forces-view is the column-view displaying the model
;; *game* is a CLOS object that holds all the state necessary for running the game.
;; In this case, we need to update which force the player has selected to add their new unit to.
;; So we setf the selected-force slot, using game/find-force to pick the appropriate force CLOS object
;; out of the hash-table of forces stored inside game.
      (gtk:connect (gtk:column-view-model forces-view) "selection-changed"
                   (lambda (model position n-items)
                     (declare (ignore position n-items))
                     (let ((uuid (gtk:string-object-string (gobj:coerce (gtk:single-selection-selected-item model) 'gtk:string-object))))
                       (setf (game/selected-force *game*) (game/find-force *game* uuid)))))

We can close this issue at your leisure.

I think it would be more appropriate for you to close this issue, so that if there are any further questions or issues, you can reopen it.

When I am in a position to write this up into something more digestible, how would you like me to send it to you?

Please feel free to open a PR to supplement the documentation or examples.

Ok, you were right I did close this too soon. I've managed to expand it a lot more, but I have come across one more issue that (I think, at least) represent the final issues I cannot figure out related to list-stores.

1) Suppose I have a button that updates a value on one of the objects being displayed in the list-store, how do I force the list-store to update? Selecting a different row by clicking works, but that's cumbersome. I tried writing the following function, but it also did not work:

   (defun force-pv-update (view)
     ;; Check which item is select and select the opposite.
     (let* ((m (gobj:coerce (gtk:column-view-model view) 'gtk:single-selection))
            (pos (gtk:single-selection-selected m)))
       (setf (gtk:single-selection-can-unselect-p m) t)
       (gtk:selection-model-unselect-all m)
       (gtk:selection-model-selection-changed m pos 1)))

I think that should unselect all selections and then reselect the previous selection (which based on my experience changing the selection manually should update the field). I have also tried incrementing and decrementing pos instead of unselecting and reselecting like so:

(gtk:selection-model-selection-changed m (+ pos 1) 1) ;; Select the next item in the list to force the update
(gtk:selection-model-selection-changed m pos 1) ;; Reset your selection

If I simply select a different item in the list (i.e. only line 1 of the above snippet), it works fine. But that feels like it would be surprising for the user to have their selection change in this list because they clicked an entirely different button halfway across the screen.

I did find a way to reduce the boilerplate when you need multiple list-stores. I created a helper class which encapsulates a lot of this boilerplate for me which I am happy to share once I polish it a bit more (it's currently lacking the sorting and filtering as I'm porting list-stores to use the model from simplest to most complex, but I hope to have it fully written by end of week).

You may need to manually call gio:list-model-items-changed on your list model after the change to signal items-changed to the column-view.

You may need to manually call gio:list-model-items-changed on your list model after the change to signal items-changed to the column-view.

Unfortunately, that still isn't working for me. Here is the helper class that should be accomplishing this. I'm currently just calling the brute-update function, but I'd rather call smart-update for larger lists.

EDIT: The function which should be signaling the change is at the end of this code snippet.

;:; CALLBACK FUNCTIONS for cffi access
;; Callback function to filter objects
(cffi:defcallback filter-string-object-via-accessor :bool
    ((item :pointer)
     (data :pointer))
  (let ((filter-func (gethash (cffi:pointer-address data) glib::*objects*)))
    (funcall filter-func (gtk:string-object-string (gobj:pointer-object item 'gtk:string-object)))))

;; Callback function to compare strings
(cffi:defcallback compare-string-object-via-accessor :int
    ((a :pointer)
     (b :pointer)
     (data :pointer))
  (let ((accessor (gethash (cffi:pointer-address data) glib::*objects*))) ; Use (glib::get-object (cffi:pointer-address data)) in the latest version of cl-glib.
    (let ((string-a (funcall accessor (gtk:string-object-string (gobj:pointer-object a 'gtk:string-object))))
          (string-b (funcall accessor (gtk:string-object-string (gobj:pointer-object b 'gtk:string-object)))))
      (if (string= string-a string-b)
          0
          (if (string< string-a string-b) +1 -1)))))

;; Callback function to compare numbers
(cffi:defcallback compare-string-number-object-via-accessor :int
    ((a :pointer)
     (b :pointer)
     (data :pointer))
  (let ((accessor (gethash (cffi:pointer-address data) glib::*objects*))) ; Use (glib::get-object (cffi:pointer-address data)) in the latest version of cl-glib.
    (let ((number-a (funcall accessor (gtk:string-object-string (gobj:pointer-object a 'gtk:string-object))))
          (number-b (funcall accessor (gtk:string-object-string (gobj:pointer-object b 'gtk:string-object)))))
      (if (= number-a number-b)
          0
          (if (< number-a number-b) +1 -1)))))

(defclass string-list ()
  ((uuids :accessor string-list/strings
          :initarg :uuids
          :documentation "The UUID strings used as keys in the source and as the strings in the model.")
   (source :accessor string-list/source
           :initarg :source
           :documentation "The hash-table which holds the objects to be displayed.")
   (selected :accessor string-list/selected
             :initarg :selected
             :initform nil
             :documentation "The currently selected object in the list store.")
   (filter-object :accessor string-list/filter-object
                  :initarg :filter-object
                  :initform nil
                  :documentation "The object used as a filter.")
   (filter :accessor string-list/filter
           :initarg :filter
           :initform nil
           :documentation "The GTK:CustomFilter object")
   (model :accessor string-list/model
          :initarg :model
          :documentation "The GTK:StringListStore object")
   (view :accessor string-list/view
         :initarg :view
         :documentation "The GTK:ColumnView object"))
  (:documentation "A helper class to manage interactions with GTK:StringListStores."))

(defun create-string-list (source &key (filter-object nil) (filter-func nil))
  "Constructor for the class."
  (let* ((uuids (loop :for u being the hash-keys of source
                      :collect u))
         (model (gtk:make-string-list :strings uuids))
         (view (gtk:make-column-view :model nil))
         (sl (make-instance 'string-list :uuids uuids :model model :view view :source source)))
    (setf (gtk:column-view-model view)
          (gtk:make-single-selection :model (gtk:make-sort-list-model :model model :sorter (gtk:column-view-sorter view))))
    (when (and filter-object filter-func)
        (string-list/add-filter sl filter-object filter-func))
    (gtk:connect (gtk:column-view-model view) "selection-changed"
                   (lambda (model position n-items)
                     (declare (ignore position n-items))
                     (let ((uuid (gtk:string-object-string (gobj:coerce (gtk:single-selection-selected-item model) 'gtk:string-object))))
                       (setf (string-list/selected sl) (gethash uuid source nil)))))
    sl))

(defmethod string-list/add-filter ((sl string-list) filter-object filter-func)
  "Adds a filter to a List store."
  (setf (string-list/filter-object sl) filter-object)
  (setf (string-list/filter sl) (gtk:make-custom-filter
                                 :match-func (cffi:callback filter-string-object-via-accessor)
                                 :user-data (cffi:make-pointer (glib::put-object (alexandria:compose (alexandria:curry filter-func (string-list/filter-object sl)) (alexandria:rcurry #'gethash (string-list/source sl)))))
                                 :user-destroy (cffi:callback glib::free-object-callback)))
  (setf (gtk:column-view-model (string-list/view sl))
        (gtk:make-single-selection :model (gtk:make-sort-list-model :model (gtk:make-filter-list-model :model (string-list/model sl) :filter (string-list/filter sl))
                                                                    :sorter (gtk:column-view-sorter (string-list/view sl))))))

(defmethod string-list/add-label-column ((sl string-list) title accessor datatype comparator)
  "Label columns sort by default."
  (let* ((fact (gtk:make-signal-list-item-factory))
         (col (gtk:make-column-view-column :title title :factory fact)))
    (gtk:column-view-append-column (string-list/view sl) col)
    (setf (gtk:column-view-column-sorter col) (gtk:make-custom-sorter
                                               :sort-func (if (string= datatype "string") ;; Two valid sorting options are string or int
                                                              (cffi:callback compare-string-object-via-accessor)
                                                              (cffi:callback compare-string-number-object-via-accessor))
                                               :user-data (cffi:make-pointer (glib::put-object (alexandria:compose comparator (alexandria:rcurry #'gethash (string-list/source sl)))))
                                               :user-destroy (cffi:callback glib::free-object-callback)))
    (gtk:connect fact "setup" (lambda (factory item)
                                (declare (ignore factory))
                                (setf (gtk:list-item-child item) (gtk:make-label :str ""))))
    (gtk:connect fact "unbind" (lambda (factory item) (declare (ignore factory item))))
    (gtk:connect fact "teardown" (lambda (factory item) (declare (ignore factory item))))
    (gtk:connect fact "bind"
                 (lambda (factory item)
                   (declare (ignore factory))
                   (let* ((uuid (gtk:string-object-string (gobj:coerce (gtk:list-item-item item) 'gtk:string-object)))
                          (row (gethash uuid (string-list/source sl)))
                          (value (format nil "~a" (funcall accessor row))))
                     (setf (gtk:label-text (gobj:coerce (gtk:list-item-child item) 'gtk:label)) value))))))

(defmethod string-list/add-color-column ((sl string-list) title accessor)
  "Adds a color column to the display. This needs to be modified to make the color 'swatch' insensitive."
  (let* ((fact (gtk:make-signal-list-item-factory))
         (col (gtk:make-column-view-column :title title :factory fact)))
    (gtk:column-view-append-column (string-list/view sl) col)
    (gtk:connect fact "setup" (lambda (factory item)
                                (declare (ignore factory))
                                (setf (gtk:list-item-child item) (gtk:make-color-dialog-button :dialog (gtk:make-color-dialog)))))
    (gtk:connect fact "unbind" (lambda (factory item) (declare (ignore factory item))))
    (gtk:connect fact "teardown" (lambda (factory item) (declare (ignore factory item))))
    (gtk:connect fact "bind"
                 (lambda (factory item)
                   (declare (ignore factory))
                   (let* ((uuid (gtk:string-object-string (gobj:coerce (gtk:list-item-item item) 'gtk:string-object)))
                          (row (gethash uuid (string-list/source sl)))
                          (value (format nil "~a" (funcall accessor row))))
                     (with-gdk-rgba (color value)
                       (setf (gtk:color-dialog-button-rgba (gobj:coerce (gtk:list-item-child item) 'gtk:color-dialog-button)) color)))))))

(defmethod string-list/add-item ((sl string-list) item item-name)
  "Add an item to the list. Doing it here makes the addition atomic."
  (let ((uuid (format nil "~a" (uuid:make-v5-uuid uuid:+namespace-dns+ item-name))))
    (setf (gethash uuid (string-list/source sl)) item)
    (unless (= (hash-table-count (string-list/source sl)) (length (string-list/strings sl)))
      (add-to-end (string-list/strings sl) uuid)
      (gtk:string-list-append (string-list/model sl) uuid))))

(defmethod string-list/brute-update ((sl string-list))
  "This update function is only useful for short lists as it manually wipes the list clean and repopulates it."
  (let* ((model (gobj:coerce (gtk:column-view-model (string-list/view sl)) 'gtk:single-selection))
         (pos (gtk:single-selection-selected model)))
    (mapcar (lambda (el) (declare (ignore el))
              (gtk:string-list-remove (string-list/model sl) 0))
            (string-list/strings sl))
    (mapcar (lambda (el)
            (gtk:string-list-append (string-list/model sl) el))
            (string-list/strings sl))
    (gtk:selection-model-select-item model pos t)))

(defmethod string-list/smart-update ((sl string-list))
  ;; Still not working
  (let* ((model (gobj:coerce (gtk:column-view-model (string-list/view sl)) 'gtk:single-selection))
         (pos (gtk:single-selection-selected model)))
    (gtk:selection-model-selection-changed model pos 1)
    (gio:list-model-items-changed model pos 0 0)))

An example of using this would look like this:

;; Assume that *data-source* is a hash-table containing Item objects with item/name, item/cost, and item/weight slots.
;; Assume that filter-items is a function that compares two items and returns true if they match.

(defun draw-item-list ()
  (let ((layout (gtk:make-scrolled-window))
          (item-list (create-string-list *data-source* (make-instance 'item) #'filter-items)))
    (string-list/add-label-column item-list "Name" #'item/name "string #'item/name)
    (string-list/add-label-column item-list "Cost" #'item/cost "int" #'item/cost)
    (string-list/add-label-column item-list "Weight" #'item/weight "int" #'item/weight)
    (let ((new-computer (make-instance 'item :name "Macbook 2023" :cost 1399 :weight 3)))
      (string-list/add-item item-list new-computer (item/name new-computer)))
    (setf (gtk:scrolled-window-child layout) (string-list/view item-list))
    layout))

Okay, I think this issue is related to GTK. When calling (gio:list-model-items-changed model 0 0 1), the items-changed signal is emitted, and the ColumnView can be updated. However, (gio:list-model-items-changed model 0 0 0) seems to have no effect on the ColumnView, meaning that gio:list-model-items-changed only works for changes in the number of elements. The simplest way to update it currently is:

(setf (gtk:column-view-model view) (prog1 (gtk:column-view-model view) (setf (gtk:column-view-model view) nil)))

bohonghuang / cl-gtk4

Using a List-store #25