guile-examples/gui/guile-gi/example-06-table.scm

;;; Example adapted from:
;;; https://github.com/spk121/guile-gi/files/7915746/gtk-tree-store.scm.txt

;;; Some formatting by me. Most comments by me.

(import (gi)
        (gi repository)
        (gi types)
        (gi util)
        ;; receive multiple values
        (ice-9 receive)
        (prefix (srfi srfi-1) srfi-1:))

;; guile-gi internally creates GOOPS classes for GTK and other GObject
;; Introspection things. Methods of such classes can have the same name. The
;; question is how those methods are named, when importing methods of same name
;; into the same module. The following like tells Guile how to handle that
;; case. For more detail see:
;; https://www.gnu.org/software/guile/manual/html_node/Merging-Generics.html
(push-duplicate-handler! 'merge-generics)


(use-typelibs ("GLib" "2.0")
              ;; Which thing is renamed to what?
              (("Gio" "2.0") #:renamer (protect* '(application:new receive)))
              ;; Which thing is renamed to what?
              (("Gtk" "3.0") #:renamer (protect* '(tree-store:new) 'gtk::))
              ("Gdk" "3.0"))


(define treeview-append-column
  (lambda* (treeview
            column
            model-column-index
            renderer
            renderer-attribute
            title
            #:key
            (pack 'start)
            (expand #f))
    (set-title column title)
    ;; Make the rendered content align to the start or end
    ;; and either make the column "expand" or not expand to
    ;; take available space, if more space exists, than the
    ;; rendered content would require.
    (when (eq? pack 'start)
      ;; See: https://docs.gtk.org/gtk3/method.TreeViewColumn.pack_start.html
      (pack-start column renderer expand))
    (when (eq? pack 'end)
      (pack-end column renderer expand))
    ;; See: https://docs.gtk.org/gtk3/method.TreeViewColumn.add_attribute.html
    (add-attribute
     ;; Specify the GtkTreeViewColumn widget, of which the
     ;; contents shall be rendered. This first the GOOPS
     ;; object to work with. add-attribute is like a method,
     ;; which expects as its first argument the object,
     ;; which it does belong to. This is like calling the
     ;; add-attribute method of the GtkTreeViewColumn
     ;; widget.
     column
     ;; Specify which GtkCellRenderer to use for the
     ;; GtkTreeViewColumn.
     renderer
     ;; Tell the GtkCellRenderer to get the value for its
     ;; "text" attribute.
     renderer-attribute
     ;; Tell the GtkCellRenderer to get the value of its
     ;; "text" attribute from column 0 of "the model" of the
     ;; GtkTreeModel. The GtkTreeModel is not known at the
     ;; time of this call, because the column has not yet
     ;; been appended to a GtkTreeView. However, once it is
     ;; appended to a GtkTreeView it will know where to get
     ;; the value from, which it will let the
     ;; GtkCellRenderer render.

     ;; Question: What sense would it make to not choose the
     ;; column in the model at the same index, as this
     ;; column is going to be added? Answer: Column widgets
     ;; may be shifted around, while the model, which holds
     ;; the data keeps indices unchanged. This means that
     ;; the index given here will keep pointing to the same
     ;; data, unless the data itself is changed.
     model-column-index)

    ;; Add the column to the tree view.
    (append-column treeview column)))


(define (activate app)
  (let* (#|main window|#
         [window (application-window:new app)]
         ;; layout manager: grid layout
         [grid (grid:new)]
         [store
          ;; Create a store, which accepts the types, which
          ;; the columns will contain. The store will back
          ;; the tree view and contain the actual data. The
          ;; data will be rendered by renderers, which one
          ;; needs to specify. The rendered data will be
          ;; displayed in the tree view.
          (gtk::tree-store:new (vector G_TYPE_INT G_TYPE_STRING G_TYPE_STRING))]
         [treeview (tree-view:new-with-model store)]
         [column-titles '("Column 1" "Column 2" "Column 3")]
         [column-renderer-attributes '("text" "text" "text")]
         #;[data ])
    ;; Connect the window delete event with a closure, which
    ;; destroys the window and quits the main loop.
    (connect window
             delete-event
             ;; The callback gets 2 arguments. The widget
             ;; from which the event originated and the
             ;; event itself.
             (λ (window event)
               (gtk-widget-destroy window)
               (gtk-main-quit)
               #f)) ;; do not stop the event propagation

    (let loop ([index 0]
               [titles column-titles]
               [renderer-attributes column-renderer-attributes])
      (cond
       [(null? titles) 'done]
       [else
        (let ([title (srfi-1:first titles)]
              [renderer-attribute (srfi-1:first renderer-attributes)])
          (treeview-append-column treeview
                                  (tree-view-column:new)
                                  index
                                  (cell-renderer-text:new)
                                  renderer-attribute
                                  title
                                  #:pack 'start #:expand #t))
        (loop (+ index 1)
              (srfi-1:drop titles 1)
              (srfi-1:drop renderer-attributes 1))]))

    (let ([iter (make <GtkTreeIter>)]
          [val1 (make <GValue>)]
          [val2 (make <GValue>)])
      ;; Set an integer value to val1.
      (set! (val1 G_TYPE_INT) 0)
      ;; Set an integer value to val2.
      (set! (val2 G_TYPE_STRING) "hello world")
      ;; Insert the values into the store, which is backing
      ;; the tree view.
      (tree-store:insert-with-values! store
                                      iter
                                      #f
                                      0
                                      (list->int-vector '(0 1))
                                      (vector val1 val2)))
    ;; Compose widgets.
    (add window grid)
    (add grid treeview)
    ;; Display the whole thing.
    (show-all window)))


(define (main)
  (let ((app (application:new "org.gtk.example" (number->application-flags 0))))
    ;; Connect the application:activate function/method with the activate
    ;; function defined above.
    (connect app application:activate activate)
    (exit
     ;; Call application:run. If there are no arguments in the command line
     ;; args, this will send the `activate' signal.
     (run app (command-line)))))


(main)