#!/bin/sh
# -*- mode: scheme; coding: utf-8 -*-
exec guile-gnome-2 -e main -s $0 "$@"
!#

(use-modules (ice-9 receive)
	     (oop goops) 
	     (gnome gobject)
	     (gnome gtk))

(define *model* #f)
(define *selection* #f)

(define (pack-tv-column tv column renderer pos)
  (pack-start column renderer #t)
  (add-attribute column renderer "text" pos)
  (append-column tv column))

(define (add-columns treeview)
  (let* ((renderer1 (make <gtk-cell-renderer-text>))
	 (column1 (make <gtk-tree-view-column>
		    #:title "What"
		    #:expand #t
		    #:alignment .5))
	 #;(adjustment2 (make <gtk-adjustment>
			#:value 0
			#:lower 0
			#:upper 100
			#:step-increment .1
			#:page-increment 1
			#:page-size 0))
	 (renderer2 (make <gtk-cell-renderer-spin>
		      ;; #:adjustment adjustment2
		      #:climb-rate 0.1
		      #:digits 1))
	 (column2 (make <gtk-tree-view-column>
		    #:title "Duration"
		    #:sizing 'fixed
		    #:fixed-width 90
		    #:alignment .5)))
    (pack-tv-column treeview column1 renderer1 0)
    (pack-tv-column treeview column2 renderer2 1)))

(define (add-model treeview)
  (let* ((column-types (list <gchararray>
			     <gfloat>))
	 (model (gtk-list-store-new column-types)))
    (set-model treeview model)
    (values model
	    (get-selection treeview))))

(define (setup-treeview treeview)
  (add-columns treeview)
  (receive (model selection)
      (add-model treeview)
    (set-mode selection 'single)
    (values model selection)))

(define (populate-model model)
  (for-each (lambda (row)
	      (let ((iter (gtk-list-store-append model)))
		(set-value model iter 0 (car row))
		(set-value model iter 1 (cadr row))))
      '(("contrib" 1.1)
	("sysadmin" 2.3))))

(define (status-push status-bar message source)
  (let ((context-id (gtk-statusbar-get-context-id status-bar source)))
    (gtk-statusbar-push status-bar context-id message)))

(define (status-pop status-bar source)
  (let ((context-id (gtk-statusbar-get-context-id status-bar source)))
    (gtk-statusbar-pop status-bar context-id)))

(define (display-both model iter spin)
  (string-append "duration, the spin: "  (number->string (get-value spin))
		 "  the cell renderer: " (number->string (get-value model iter 1))))

(define (animate)
  (let* ((window (make <gtk-window>
		   #:type 'toplevel
		   #:title "Gtk cell renderer spin"))
	 (vbox (make <gtk-vbox>
		 #:homogeneous #f
		 #:spacing 2))
	 (adjustment (make <gtk-adjustment>
		       #:value 0
		       #:lower 0
		       #:upper 100
		       #:step-increment .1
		       #:page-increment 1
		       #:page-size 0))
	 (spin (make <gtk-spin-button>
		 #:adjustment adjustment
		 #:climb-rate .1
		 #:digits 1))
	 (scrollw (make <gtk-scrolled-window>
		    #:hscrollbar-policy 'never
		    #:vscrollbar-policy 'automatic))
	 (treeview (make <gtk-tree-view>))
	 (statusbar (make <gtk-statusbar>)))
    (set-default-size window 400 150)
    (receive (model selection)
	(setup-treeview treeview)
      (populate-model model)
      (add window vbox)
      (add scrollw treeview)
      (pack-start vbox spin #f #f 0)
      (pack-start vbox scrollw #t #t 0)
      (pack-start vbox statusbar #f #f 0)
      (connect window
	       'delete-event
	       (lambda (widget event)
		 (destroy widget)
		 (gtk-main-quit)
		 #f))
      (connect spin
	       'value-changed
	       (lambda (widget)
		 (receive (model iter)
		     (get-selected selection)
		   (set-value model iter 1 (get-value widget))
		   (status-pop statusbar "")
		   (status-push statusbar (display-both model iter spin) ""))))
      (connect selection
	       'changed
	       (lambda (selection)
		 (receive (model iter)
		     (get-selected selection)
		   (status-pop statusbar "")
		   (status-push statusbar (display-both model iter spin) ""))))
      (select-path selection (list 0)))
    (show-all window)
    (gtk-main)))

(define (main args)
  (animate))