treeview - gtk-cell-renderer-spin - 2 problems

David Pirotte <[email protected]> Wed, 24 Jul 2013 17:35:16 -0300
Newsgroups gmane.lisp.guile.gtk
Message-ID <20130724173516.559e8420@capac>
--MP_/thMpDBz6kngUqXT3oTXYj11
Content-Type: text/plain; charset=US-ASCII
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

Hello guilers,
guile-gnomers,

	guile-gnome from git - the latest
	GNU Guile 2.0.9.20-10454

So far i did render floats myself, using text renderer, mono space right
justified ... because i could never make the <gtk-cell-renderer-spin> correctly
display the number of decimals i wanted.

I'd like to see if it possible to solve this problem, so i built a small example to
play with. As you can see there are 2 problems.

1-	the renderer does not implement the digits i am passing (line 35);
2-	the values it stores and give back are not [exactly] the values i am given
	(lines 64, 65).

	[i also tried to define and use an adjustment, but it does not change the
	fact that the renderer fails to display the right digit number it receives]

Hints/debug suggestions welcome,
David

--MP_/thMpDBz6kngUqXT3oTXYj11
Content-Type: text/x-scheme
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
 filename=gtk-cell-renderer-spin-digits-prob.scm

#!/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 (animate)
  (let* ((window (make <gtk-window>
		   #:type 'toplevel
		   #:title "Gtk renderer spin test"))
	 (vbox (make <gtk-vbox>
		 #:homogeneous #f
		 #:spacing 2))
	 (hbox (make <gtk-hbox>
		 #:homogeneous #f
		 #:spacing 2))
	 (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 scrollw #t #t 0)
      (pack-start vbox hbox #f #f 0)
      (pack-start vbox statusbar #f #f 0)
      (connect window
	       'delete-event
	       (lambda (widget event)
		 (destroy widget)
		 (gtk-main-quit)
		 #f))
      (connect selection
	       'changed
	       (lambda (selection)
		 (receive (model iter)
		     (get-selected selection)
		   (status-pop statusbar "")
		   (status-push statusbar 
				(string-append "duration: " (number->string (get-value model iter 1)))
				""))))
      (select-path selection (list 0)))
    (show-all window)
    (gtk-main)))

(define (main args)
  (animate))

--MP_/thMpDBz6kngUqXT3oTXYj11
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

_______________________________________________
guile-gtk-general mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/guile-gtk-general

--MP_/thMpDBz6kngUqXT3oTXYj11--