
;; Copyright (C) 2016, 2021  Tommi Höynälänmaa

;; This file is part of Theme-D-Intr.

;; You can redistribute and/or modify this file under the terms of the
;; GNU General Public License as published by the Free Software
;; Foundation, either version 3 of the License, or (at your option) any
;; later version.

;; This file is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see https://www.gnu.org/licenses/.


(define-body (intr-gtk4-examples theme-d-intr-demo list-store)

  (import (standard-library dynamic-list)
	  (standard-library goops-classes)
	  (standard-library list-utilities)
	  (standard-library string-utilities)
	  (intr-gtk4-examples theme-d-intr-demo _intr-imports)
	  (intr-gtk4-examples theme-d-intr-demo support))


  (define connect gtype-instance-signal-connect)


  (define gtk-tree-model-get-iter1
    (prim-proc gtk-tree-model-get-iter1 (<object> <pointer>) <pointer> pure))


  (define gl-l-data
    '((#f 60482 "Normal"      "scrollable notebooks and hidden tabs")
      (#f 60620 "Critical"    "gdk_window_clear_area (gdkwindow-win32.c) is not thread-safe")
      (#f 50214 "Major"       "Xft support does not clean up correctly")
      (#t 52877 "Major"       "GtkFileSelection needs a refresh method. ")
      (#f 56070 "Normal"      "Can't click button after setting in sensitive")
      (#t 56355 "Normal"      "GtkLabel - Not all changes propagate correctly")
      (#f 50055 "Normal"      "Rework width/height computations for TreeView")
      (#f 58278 "Normal"      "gtk_dialog_set_response_sensitive () doesn't work")
      (#f 55767 "Normal"      "Getters for all setters")
      (#f 56925 "Normal"      "Gtkcalender size")
      (#f 56221 "Normal"      "Selectable label needs right-click copy menu")
      (#t 50939 "Normal"      "Add shift clicking to GtkTextView")
      (#f 6112  "Enhancement" "netscape-like collapsable toolbars")
      (#f 1     "Normal"      "First bug :=)")))


  (define-simple-method populate-model (((liststore <gtk-list-store>)) <none>
					nonpure)
    (for-each1
     (lambda (((l-row <list>)) <none> nonpure)
       (let ((iter (gtk-list-store-append liststore)))
	 (for-each
	  (lambda (((i-col <integer>) (x-data <object>)) <none> nonpure)
	    (set-value liststore iter i-col x-data))
	  '(0 1 2 3) l-row)))
     gl-l-data))


  (define-simple-method fixed-toggled (((liststore <gtk-list-store>)
					(path <gtk-tree-path>))
				       <none> nonpure)
    (let* ((iter (gtk-tree-model-get-iter1 liststore path))
	   (fixed? (not (cast <boolean>
			      (gtk-tree-model-get-value liststore iter 0)))))
      (set-value liststore iter 0 fixed?)))


  (define-simple-method add-columns (((treeview <gtk-tree-view>)
				      (treemodel <gtk-tree-model>))
				     <none> nonpure)
    (let* ((renderer1 (gtk-cell-renderer-toggle-new))
	   (column1 (gtk-tree-view-column-new))
	   (renderer2 (gtk-cell-renderer-text-new))
	   (column2 (gtk-tree-view-column-new))
	   (renderer3 (gtk-cell-renderer-text-new))
	   (column3 (gtk-tree-view-column-new))
	   (renderer4 (gtk-cell-renderer-text-new))
	   (column4 (gtk-tree-view-column-new)))
      (set-title column1 "Fixed?")
      (set-sizing column1 'fixed)
      (set-fixed-width column1 50)
      (set-title column2 "Bug number")
      (set-title column3 "Severity")
      (set-title column4 "Description")

      (connect
       renderer1 'toggled
       (lambda (((l-args (rest <object>))) <object> nonpure)
	 (let ((path (cast <pointer>
			   (gtk-tree-path-new-from-string
			    (cast <string> (d-car (d-cdr l-args)))))))
	   (fixed-toggled (cast <gtk-list-store> treemodel) path)
	   null)))

      (pack-start column1 renderer1 #f)
      (add-attribute column1 renderer1 "active" 0)
      (append-column treeview column1)

      (pack-start column2 renderer2 #f)
      (add-attribute column2 renderer2 "text" 1)
      (set-sort-column-id column2 1)
      (append-column treeview column2)

      (pack-start column3 renderer3 #f)
      (add-attribute column3 renderer3 "text" 2)
      (set-sort-column-id column3 2)
      (append-column treeview column3)

      (pack-start column4 renderer4 #f)
      (add-attribute column4 renderer4 "text" 3)
      (set-sort-column-id column4 4)
      (append-column treeview column4)))


  (define-simple-method run-list-store-demo (((window-parent <gtk-window>))
					     <none> nonpure)
    (let* ((window (cast <gtk-window> (gtk-window-new)))
	   (vbox (cast <gtk-box> (gtk-box-new 'vertical 8)))
	   (label
	    (cast <gtk-label>
		  (gtk-label-new
		   (string-append 
		    "This is the bug list (note: not based on real "
		    "data, it would be nice to have a nice ODBC "
		    "interface to bugzilla or so, though)."))))
	   (scrwin
	    (cast <gtk-scrolled-window> (gtk-scrolled-window-new)))
	   (model (gtk-list-store-new 
		   '(boolean int string string)))
	   (treeview
	    (cast <gtk-tree-view> (gtk-tree-view-new-with-model model))))
      (set-title window "GtkListStore")
      (set-size-request window 500 400)
      ;; (gobject-set window 'default-width 280)
      ;; (gobject-set window 'default-height 250)
      ;; (set-border-width window 8)
      (set-policy scrwin 'never 'automatic)
      ;; (set-shadow-type scrwin 'etched-in)
      ;; (set-rules-hint treeview #t)
      (set-search-column treeview 3)

      (populate-model model)

      (set-child window vbox)
      (gtk-box-append vbox label)
      (gtk-box-append vbox scrwin)
      (set-vexpand scrwin #t)
      
      (set-child scrwin treeview)

      (add-columns treeview model)

      (set-modal window #t)
      (set-transient-for window window-parent)

      (show window)))


  (define-simple-method get-list-store-demo (() <demo> force-pure)
    (let* ((str-name "Tree View/List Store")
	   (str-module-name "list-store")
	   (str-desc
	    (string-append
	     "The GtkListStore is used to store data in list form, to be used "
	     "later on by a GtkTreeView to display it. This demo builds a "
	     "simple GtkListStore and displays it. See the Stock Browser "
	     "demo for a more advanced example."))
	   (demo (make <demo> str-name str-module-name str-desc "" ""
		       run-list-store-demo)))
      (demo-compute-source demo)
      demo)))
