dmitry_vk's notes

GtkTreeView example for cl-gtk2

My hacking on CL-GTK2 continues. I made a little tutorial and a Lisp class browser (that's sometimes very useful to me). It was not hard, but I keep forgetting how to use GtkTreeView.

Here's what it looks like:

screenshot

And that's the code for it:

(defun demo-class-browser ()
  (let ((output *standard-output*))
    (with-main-loop
        (let* ((window (make-instance 'gtk-window
                                      :window-position :center
                                      :title "Class Browser"
                                      :default-width 400
                                      :default-height 600))
               (search-entry (make-instance 'entry))
               (search-button (make-instance 'button :label "Search"))
               (scroll (make-instance 'scrolled-window
                                      :hscrollbar-policy :automatic
                                      :vscrollbar-policy :automatic))
               (slots-model (make-instance 'array-list-store))
               (slots-list (make-instance 'tree-view :model slots-model)))
          (let ((v-box (make-instance 'v-box))
                (search-box (make-instance 'h-box)))
            (container-add window v-box)
            (box-pack-start v-box search-box :expand nil)
            (box-pack-start search-box search-entry)
            (box-pack-start search-box search-button :expand nil)
            (box-pack-start v-box scroll)
            (container-add scroll slots-list))
          (store-add-column slots-model "gchararray"
                            (lambda (slot)
                              (format nil "~S" (closer-mop:slot-definition-name slot))))
          (let ((col (make-instance 'tree-view-column :title "Slot name"))
                (cr (make-instance 'cell-renderer-text)))
            (tree-view-column-pack-start col cr)
            (tree-view-column-add-attribute col cr "text" 0)
            (tree-view-append-column slots-list col))
          (labels ((display-class-slots (class)
                     (format output "Displaying ~A~%" class)
                     (loop
                        repeat (store-items-count slots-model)
                        do (store-remove-item slots-model (store-item slots-model 0)))
                     (closer-mop:finalize-inheritance class)
                     (loop
                        for slot in (closer-mop:class-slots class)
                        do (store-add-item slots-model slot)))
                   (on-search-clicked (button)
                     (declare (ignore button))
                     (with-gtk-message-error-handler
                         (let* ((class-name (read-from-string (entry-text search-entry)))
                                (class (find-class class-name)))
                           (display-class-slots class)))))
            (g-signal-connect search-button "clicked" #'on-search-clicked))
          (widget-show window)))))