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

(define-body (gnome-examples theme-d-gnome-demo list-store)

  (import (standard-library dynamic-list)
	  (standard-library goops-classes)
	  (standard-library list-utilities)
	  (standard-library string-utilities)
	  (gnome gtk)
	  (gnome gobject))


  (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-proc 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-proc fixed-toggled (((liststore <gtk-list-store>)
				      (path <gtk-tree-path>))
				     <none> nonpure)
    (let* ((iter (gtk-tree-model-get-iter liststore path))
	   (fixed? (not (cast <boolean>
			      (gtk-tree-model-get-value liststore iter 0)))))
      (set-value liststore iter 0 fixed?)))


  (define-simple-proc add-columns (((treeview <gtk-tree-view>)) <none> nonpure)
    (let* ((treemodel (gtk-tree-view-get-model treeview))
	   (renderer1 (gtk-cell-renderer-toggle-create))
	   (column1 (gtk-tree-view-column-create))
	   (renderer2 (gtk-cell-renderer-text-create))
	   (column2 (gtk-tree-view-column-create))
	   (renderer3 (gtk-cell-renderer-text-create))
	   (column3 (gtk-tree-view-column-create))
	   (renderer4 (gtk-cell-renderer-text-create))
	   (column4 (gtk-tree-view-column-create)))
      (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 <gtk-tree-path> (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-proc run-list-store-demo (((window-parent <gtk-window>))
					   <none> nonpure)
    (let* ((window (gtk-window-create 'toplevel))
	   (vbox (gtk-vbox-create #f 8))
	   (label (gtk-label-create
		   (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 (gtk-scrolled-window-create #f #f))
	   (model (gtk-list-store-create
		   (map1 get-raw-goops-class
			 (list <gboolean> <guint> <gchararray> <gchararray>))))
	   (treeview (gtk-tree-view-create-with-model model)))
      (set-title window "GtkListStore")
      (gobject-set-property window 'default-width 280)
      (gobject-set-property 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)

      (add window vbox)
      (pack-start vbox label #f #f 0)
      (pack-start vbox scrwin #t #t 0)
      (add scrwin treeview)

      (add-columns treeview)

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

      (show-all window)))


  (define-simple-proc 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)))
