ADDED   examples/iupwidgetinfo.scm
Index: examples/iupwidgetinfo.scm
==================================================================
--- /dev/null
+++ examples/iupwidgetinfo.scm
@@ -0,0 +1,191 @@
+#! /usr/bin/env csi
+
+(require-library srfi-4 iup)
+(import srfi-4 iup iup-pplot iup-glcanvas)
+
+(define (popup dlg . args)
+  (apply show dlg #:modal? 'yes args)
+  (destroy! dlg))
+
+(define (properties ih)
+  (popup (element-properties-dialog ih))
+  'default)
+
+(define dlg
+  (dialog
+    (vbox
+      (hbox ; headline
+        (fill)
+        (frame (label " Inspect control and dialog classes "
+                      fontsize: 15))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Dialogs" fontsize: 12)
+      (hbox
+        (button "dialog"
+                action: (lambda (self) (properties (dialog (vbox)))))
+        (button "color-dialog"
+                action: (lambda (self) (properties (color-dialog))))
+        (button "file-dialog"
+                action: (lambda (self) (properties (file-dialog))))
+        (button "font-dialog"
+                action: (lambda (self) (properties (font-dialog))))
+        (button "message-dialog"
+                action: (lambda (self) (properties (message-dialog))))
+        (fill)
+        margin: '0x0)
+      (hbox
+        (button "layout-dialog"
+                action: (lambda (self) (properties (layout-dialog))))
+        (button "element-properties-dialog"
+                action: (lambda (self)
+                          (properties
+                            (element-properties-dialog (create 'user)))))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Composition widgets" fontsize: 12)
+      (hbox
+        (button "fill"
+                action: (lambda (self) (properties (fill))))
+        (button "hbox"
+                action: (lambda (self) (properties (hbox))))
+        (button "vbox"
+                action: (lambda (self) (properties (vbox))))
+        (button "zbox"
+                action: (lambda (self) (properties (zbox))))
+        (button "radio"
+                action: (lambda (self) (properties (radio (vbox)))))
+        (button "normalizer"
+                action: (lambda (self) (properties (normalizer))))
+        (button "cbox"
+                action: (lambda (self) (properties (cbox))))
+        (button "sbox"
+                action: (lambda (self) (properties (sbox (vbox)))))
+        (button "split"
+                action: (lambda (self) (properties (split (vbox) (vbox)))))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Standard widgets" fontsize: 12)
+      (hbox
+        (button "button"
+                action: (lambda (self) (properties (button))))
+        (button "canvas"
+                action: (lambda (self) (properties (canvas))))
+        (button "frame"
+                action: (lambda (self) (properties (frame))))
+        (button "label"
+                action: (lambda (self) (properties (label))))
+        (button "listbox"
+                action: (lambda (self) (properties (listbox))))
+        (button "progress-bar"
+                action: (lambda (self) (properties (progress-bar))))
+        (button "spin"
+                action: (lambda (self) (properties (spin))))
+        (fill)
+        margin: '0x0)
+      (hbox
+        (button "tabs"
+                action: (lambda (self) (properties (tabs))))
+        (button "textbox"
+                action: (lambda (self) (properties (textbox))))
+        (button "toggle"
+                action: (lambda (self) (properties (toggle))))
+        (button "treebox"
+                action: (lambda (self) (properties (treebox))))
+        (button "valuator"
+                action: (lambda (self) (properties (valuator ""))))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Additional widgets" fontsize: 12)
+      (hbox
+        (button "cells"
+                action: (lambda (self) (properties (cells))))
+        (button "color-bar"
+                action: (lambda (self) (properties (color-bar))))
+        (button "color-browser"
+                action: (lambda (self) (properties (color-browser))))
+        (button "dial"
+                action: (lambda (self) (properties (dial ""))))
+        (button "matrix"
+                action: (lambda (self) (properties (matrix))))
+        (fill)
+        margin: '0x0)
+      (hbox
+        (button "pplot"
+                action: (lambda (self) (properties (pplot))))
+        (button "glcanvas"
+                action: (lambda (self) (properties (glcanvas))))
+        (button "web-browser"
+                action: (lambda (self) (properties (web-browser))))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Menu widgets" fontsize: 12)
+      (hbox
+        (button "menu"
+                action: (lambda (self) (properties (menu))))
+        (button "menu-item"
+                action: (lambda (self) (properties (menu-item))))
+        (button "menu-separator"
+                action: (lambda (self) (properties (menu-separator))))
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Images" fontsize: 12)
+      (hbox
+        (button "image/palette"
+                action: (lambda (self)
+                          (properties
+                            (image/palette 1 1 (u8vector->blob (u8vector 0))))))
+        (button "image/rgb"
+                action: (lambda (self)
+                          (properties
+                            (image/rgb 1 1 (u8vector->blob (u8vector 0))))))
+        (button "image/rgba"
+                action: (lambda (self)
+                          (properties
+                            (image/rgba 1 1 (u8vector->blob (u8vector 0))))))
+        (button "image/file"
+                action: (lambda (self)
+                          (properties
+                            ;; same attributes as image/palette
+                            (image/palette 1 1 (u8vector->blob (u8vector 0))))))
+                            ;; needs a file in current directory
+                            ;(image/file "chicken.ico")))) ; ok
+                            ;(image/file "chicken.png")))) ; doesn't work
+        (fill)
+        margin: '0x0)
+
+      (label "") 
+      (label "Other widgets" fontsize: 12)
+      (hbox
+        (button "clipboard"
+                action: (lambda (self) (properties (clipboard))))
+        (button "timer"
+                action: (lambda (self) (properties (timer))))
+        (button "spinbox"
+                action: (lambda (self) (properties (spinbox (vbox)))))
+        (fill)
+        margin: '0x0)
+
+      (fill)
+      (button "E&xit"
+              expand: 'horizontal
+              action: (lambda (self) 'close))
+      )
+    margin: '15x15
+    title: "Iup inspector"))
+
+(show dlg)
+(main-loop)
+(exit 0)

ADDED   examples/simple.scm
Index: examples/simple.scm
==================================================================
--- /dev/null
+++ examples/simple.scm
@@ -0,0 +1,259 @@
+(require-library iup)
+(import (prefix iup iup:))
+;; (use canvas-draw canvas-draw-iup)
+(use srfi-4)
+
+(define img-bits1 (u8vector->blob (u8vector
+ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1
+ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1
+ 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1
+ 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1
+ 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1
+ 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1
+ 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1
+ 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1
+ 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 2 2 2 0 2 0 2 0 2 2 0 2 2 2 0 0 0 2 2 2 0 0 2 0 2 2 0 0 0 2 2 2
+ 2 2 2 0 2 0 0 2 0 0 2 0 2 0 2 2 2 0 2 0 2 2 0 0 2 0 2 2 2 0 2 2
+ 2 2 2 0 2 0 2 2 0 2 2 0 2 2 2 2 2 0 2 0 2 2 2 0 2 0 2 2 2 0 2 2
+ 2 2 2 0 2 0 2 2 0 2 2 0 2 2 0 0 0 0 2 0 2 2 2 0 2 0 0 0 0 0 2 2
+ 2 2 2 0 2 0 2 2 0 2 2 0 2 0 2 2 2 0 2 0 2 2 2 0 2 0 2 2 2 2 2 2
+ 2 2 2 0 2 0 2 2 0 2 2 0 2 0 2 2 2 0 2 0 2 2 0 0 2 0 2 2 2 0 2 2
+ 2 2 2 0 2 0 2 2 0 2 2 0 2 2 0 0 0 0 2 2 0 0 2 0 2 2 0 0 0 2 2 2
+ 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 2 2 2 2 2 2 2 2
+ 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 2 2 2 0 2 2 2 2 2 2 2 2
+ 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 0 0 2 2 2 2 2 2 2 2 2
+ 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1
+ 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1
+ 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1
+ 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+ 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+ 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+ 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+ 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+)))
+
+(define img-bits2 (u8vector->blob (u8vector
+ 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2
+ 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2
+ 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2
+ 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2
+ 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2
+ 2 2 2 2 2 2 2 2 2 2 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2
+ 2 2 2 2 2 2 2 2 2 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2
+ 2 2 2 2 2 2 2 2 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2
+ 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
+ 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
+ 3 3 3 0 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
+ 3 3 3 0 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
+ 3 3 3 0 3 0 3 0 3 3 0 3 3 3 1 1 0 3 3 3 0 0 3 0 3 3 0 0 0 3 3 3
+ 3 3 3 0 3 0 0 3 0 0 3 0 3 0 1 1 3 0 3 0 3 3 0 0 3 0 3 3 3 0 3 3
+ 3 3 3 0 3 0 3 3 0 3 3 0 3 3 1 1 3 0 3 0 3 3 3 0 3 0 3 3 3 0 3 3
+ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+ 3 3 3 0 3 0 3 3 0 3 3 0 3 0 1 1 3 0 3 0 3 3 0 0 3 0 3 3 3 0 3 3
+ 3 3 3 0 3 0 3 3 0 3 3 0 3 3 1 1 0 0 3 3 0 0 3 0 3 3 0 0 0 3 3 3
+ 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 0 3 3 3 3 3 3 3 3
+ 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 0 3 3 3 0 3 3 3 3 3 3 3 3
+ 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 0 0 0 3 3 3 3 3 3 3 3 3
+ 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
+ 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
+ 2 2 2 2 2 2 2 3 3 3 3 3 3 3 1 1 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2
+ 2 2 2 2 2 2 3 3 3 3 3 3 3 3 1 1 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2
+ 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
+)))
+
+(define (iup:item-set-attributes! item . attrlst)
+  (for-each (lambda (attrtok)
+	      (let ((attrlst (string-split attrtok "=")))
+		(iup:attribute-set! item (car attrlst)(cadr attrlst))))
+	    attrlst)
+  item)
+
+(define (myaction)
+  (print "My action called"))
+
+(define (init-dialog)
+  (let ((img1    (iup:image/palette 32 32 img-bits1))
+	(img2    (iup:image/palette 32 32 img-bits2))
+	(mnu     #f)
+	(_frm-1  #f)
+	(_frm-2  #f)
+	(_frm-3  #f)
+	(_frm-4  #f)
+	(_frm-5  #f)
+	(_list-1 #f)
+	(_list-2 #f)
+	(_list-3 #f)
+	(_hbox-1 #f)
+	(_vbox-1 #f)
+	(_cnv-1  #f)
+	(dlg     #f)
+	(c1      #f))
+    (iup:handle-name-set! img1 "img1")
+    (iup:attribute-set! img1 "0" "0 0 0")
+    (iup:attribute-set! img1 "1" "BGCOLOR")
+    (iup:attribute-set! img1 "2" "255 0 0")
+
+    (iup:handle-name-set! img2 "img2")
+    (iup:attribute-set! img2 "0" "0 0 0")
+    (iup:attribute-set! img2 "1" "0 255 0")
+    (iup:attribute-set! img2 "2" "BGCOLOR")
+    (iup:attribute-set! img2 "3" "255 0 0")
+
+    (set! mnu (iup:menu
+	       (iup:item-set-attributes!
+		(iup:menu-item "IupSubmenu 1" 
+			       (iup:menu
+				(iup:item-set-attributes! 
+				 (iup:menu-item "IupItem 1 Checked" "myaction")
+				 "VALUE=ON")
+				(iup:menu-separator)
+				(iup:item-set-attributes!
+				 (iup:menu-item "IupItem 2 Disabled" "myaction")
+				 "ACTIVE=NO"))))))
+    (iup:handle-name-set! mnu "mnu")
+
+    (set! _frm-1 (iup:frame 
+		  (iup:vbox 
+		   (iup:button "Button Text" #:action (lambda (x)(print "Blah" x)))
+		   (iup:item-set-attributes!
+		    (iup:button "" #:action print) "IMAGE=img1")
+		   (iup:item-set-attributes! 
+		    (iup:button "" #:action print) "IMAGE=img1" "IMPRESS=img2"))))
+    (iup:attribute-set! _frm-1 "TITLE" "IupButton")
+
+    (set! _frm-2 (iup:frame
+		  (iup:vbox
+		   (iup:label "Label Text")
+		   (iup:item-set-attributes! 
+		    (iup:label "") "SEPARATOR=HORIZONTAL")
+		   (iup:item-set-attributes!
+		    (iup:label "") "IMAGE=img1"))))
+    (iup:attribute-set! _frm-2 "TITLE" "IupLabel")
+
+    (set! _frm-3 (iup:frame
+		  (iup:vbox 
+		   (iup:item-set-attributes! 
+		    (iup:toggle "Toggle Text" "myaction") "VALUE=ON")
+		   (iup:item-set-attributes!
+		    (iup:toggle "" "myaction") "IMAGE=img1" "IMPRESS=img2")
+		   (iup:item-set-attributes!
+		    (iup:frame
+		     (iup:radio
+		      (iup:vbox
+		       (iup:toggle "Toggle Text" "myaction")
+		       (iup:toggle "Toggle Text" "myaction")))) "TITLE=IupRadio"))))
+    (iup:attribute-set! _frm-3 "TITLE" "IupToggle")
+
+    (set! _text-1 (iup:textbox "myaction"))
+    (iup:attribute-set! _text-1 "VALUE" "IupText Text")
+    (iup:attribute-set! _text-1 "SIZE" "80x")
+    
+    (set! _m1-1 (iup:textbox "myaction"))
+    (iup:attribute-set! _m1-1 "MULTILINE" "YES")
+    (iup:attribute-set! _m1-1 "VALUE" "IupMultiline Text\nSecond Line\nThird Line")
+    (iup:attribute-set! _m1-1 "EXPAND" "YES")
+    (iup:attribute-set! _m1-1 "SIZE" "80x60")
+
+    (set! _frm-4 (iup:frame
+		  (iup:vbox
+		   _text-1
+		   _m1-1)))
+    (iup:attribute-set! _frm-4 "TITLE" "IupText/IupMultiline")
+
+    (set! _list-1 
+	  (iup:item-set-attributes! 
+	   (iup:listbox "myaction")
+	   "EXPAND=YES" 
+	   "VALUE=1"
+	   "1=Item 1 Text"
+	   "2=Item 2 Text"
+	   "3=Item 3 Text"))
+	  
+    (set! _list-2
+	  (iup:item-set-attributes!
+	   (iup:listbox "myaction")
+	   "DROPDOWN=YES"
+	   "EXPAND=YES"
+	   "VALUE=2"
+	   "1=Item 1 Text"
+	   "2=Item 2 Text"
+	   "3=Item 3 Text"))
+
+    (set! _list-3
+	  (iup:item-set-attributes!
+	   (iup:listbox "myaction")
+	   "EDITBOX=YES"
+	   "EXPAND=YES"
+	   "VALUE=3"
+	   "1=Item 1 Text"
+	   "2=Item 2 Text"
+	   "3=Item 3 Text"))
+
+    (set! _frm-5 (iup:frame
+		  (iup:vbox
+		   _list-1
+		   _list-2
+		   _list-3)))
+    (iup:attribute-set! _frm-5 "TITLE" "IupList")
+	   
+    (set! _hbox-1 (iup:hbox
+		   _frm-1
+		   _frm-2
+		   _frm-3
+		   _frm-4
+		   _frm-5))
+
+  ;;   (set! _cnv-1 
+  ;;         ;; (iup:item-set-attributes!
+  ;;         ;;(iup:canvas)
+  ;;         ;; "BGCOLOR=128 255 0" 
+  ;;         ;; "SCROLLBAR=yes"))
+  ;;         ;; (iup:handle-name-set! _cnv-1 "cnv1")
+  ;; 
+  ;;         ;; (use iup canvas-draw canvas-draw-iup)
+  ;;         ;; (define dlg
+  ;;         ;;   (dialog #:title "Test" #:minsize "320x240"
+  ;;         (iup:canvas #:action (make-canvas-action
+  ;;       			(lambda (cnv x y)
+  ;;       			  (canvas-clear! cnv)
+  ;;       			  (canvas-text! cnv 40 40 "Hello world!")
+  ;;       			  (canvas-rectangle! cnv 90 120 70 100)))
+  ;;       	      #:size "200x100"))
+    ;; )
+    ;; (show dlg)
+    ;; (main-loop)
+    (set! _vbox-1 (iup:vbox
+		   _hbox-1
+		   ;; _cnv-1
+		   ))
+
+    (iup:attribute-set! _vbox-1 "MARGIN" "5x5")
+    (iup:attribute-set! _vbox-1 "ALIGNMENT" "ARIGHT")
+    (iup:attribute-set! _vbox-1 "GAP" "5")
+    
+    (set! dlg (iup:dialog _vbox-1))
+    (iup:handle-name-set! dlg "dlg")
+    (iup:attribute-set! dlg "MENU" "mnu")
+    (iup:attribute-set! dlg "TITLE" "Iup Sample")
+
+    ;; (set! c1 (make-canvas context:iup "cnv1"))
+;; (iup:handle-ref "cnv1")))
+;; _cnv-1))
+    ;; (canvas-rectangle! c1 10 10 40 40)
+    ))
+    
+(init-dialog)
+(iup:show (iup:handle-ref "dlg"))
+(iup:main-loop)

ADDED   examples/tree.scm
Index: examples/tree.scm
==================================================================
--- /dev/null
+++ examples/tree.scm
@@ -0,0 +1,147 @@
+;; Some tree utilities. (C) 2014 Matt Welland, GPL V2.0
+;; Take from Megatest http://www.kiatoa.com/fossils/megatest
+;;
+(use test)
+(require-library iup)
+(import (prefix iup iup:))
+
+(define t #f) 
+
+(define tree-dialog
+  (iup:dialog
+   #:title "Tree Test"
+   (let ((t1 (iup:treebox
+	      #:selection_cb (lambda (obj id state)
+			       (print "selection_db with id=" id " state=" state)
+			       (print "USERDATA: " (iup:attribute obj "USERDATA"))
+			       (print "SPECIALDATA: " (iup:attribute obj "SPECIALDATA"))
+			       (print "Depth: " (iup:attribute obj "DEPTH"))
+			       ))))
+     (set! t t1)
+     t1)))
+
+(iup:show tree-dialog)
+
+(map (lambda (elname el)
+       (print "Adding " elname " with value " el)
+       (iup:attribute-set! t elname el)
+       (iup:attribute-set! t "USERDATA" el))
+     '("VALUE" "NAME"    "ADDLEAF" "ADDBRANCH1" "ADDLEAF2"    "VALUE")
+     '("0"     "Figures" "Other"   "triangle"   "equilateral" "4")
+     )
+(map (lambda (attr)
+       (print attr " is " (iup:attribute t attr)))
+     '("KIND1" "PARENT2" "STATE1"))
+
+(define (tree-find-node obj path)
+  ;; start at the base of the tree
+  (if (null? path)
+      #f ;; or 0 ????
+      (let loop ((hed      (car path))
+		 (tal      (cdr path))
+		 (depth    0)
+		 (nodenum  0))
+	;; nodes in iup tree are 100% sequential so iterate over nodenum
+	(if (iup:attribute obj (conc "DEPTH" nodenum)) ;; end when no more nodes
+	    (let ((node-depth (string->number (iup:attribute obj (conc "DEPTH" nodenum))))
+		  (node-title (iup:attribute obj (conc "TITLE" nodenum))))
+	      ;; (print 0 "hed: " hed ", depth: " depth ", node-depth: " node-depth ", nodenum: " nodenum ", node-title: " node-title)
+	      (if (and (equal? depth node-depth)
+		       (equal? hed   node-title)) ;; yep, this is the one!
+		  (if (null? tal) ;; end of the line
+		      nodenum
+		      (loop (car tal)(cdr tal)(+ depth 1)(+ 1 nodenum)))
+		  ;; this is the case where we found part of the hierarchy but not 
+		  ;; all of it, i.e. the node-depth went from deep to less deep
+		  (if (> depth node-depth) ;; (+ 1 node-depth))
+		      #f
+		      (loop hed tal depth (+ nodenum 1)))))
+	    #f))))
+
+;; top is the top node name zeroeth node VALUE=0
+(define (tree-add-node obj top nodelst)
+  (if (not (iup:attribute obj "TITLE0"))
+      (iup:attribute-set! obj "ADDBRANCH0" top))
+  (cond
+   ((not (string=? top (iup:attribute obj "TITLE0")))
+    (print "ERROR: top name " top " doesn't match " (iup:attribute obj "TITLE0")))
+   ((null? nodelst))
+   (else
+    (let loop ((hed      (car nodelst))
+	       (tal      (cdr nodelst))
+	       (depth    1)
+	       (pathl    (list top)))
+      ;; Because the tree dialog changes node numbers when
+      ;; nodes are added or removed we must look up nodes
+      ;; each and every time. 0 is the top node so default
+      ;; to that.
+      (let* ((newpath    (append pathl (list hed)))
+	       (parentnode (tree-find-node obj pathl))
+	       (nodenum    (tree-find-node obj newpath)))
+	  ;; (print "newpath: " newpath ", nodenum " nodenum ", hed: " hed ", depth: " depth ", parentnode: " parentnode ", pathl: " pathl)
+	  ;; Add the branch under lastnode if not found
+	  (if (not nodenum)
+	      (begin
+		(iup:attribute-set! obj (conc "ADDBRANCH" parentnode) hed)
+		(if (null? tal)
+		    #t
+		    ;; reset to top
+		    (loop (car nodelst)(cdr nodelst) 1 (list top)))) 
+	      (if (null? tal) ;; if null here then this path has already been added
+		  #t
+		  ;; (if nodenum
+		  (loop (car tal)(cdr tal)(+ depth 1) newpath)))))))) ;;  (if nodenum nodenum lastnode)))))))
+	      ;; 	  (loop hed tal depth pathl lastnode)))))))
+
+(define (tree-node->path obj nodenum)
+  ;; (print "\ncurrnode  nodenum  depth  node-depth  node-title   path")
+  (let loop ((currnode 0)
+	     (depth    0)
+	     (path     '()))
+    (let ((node-depth (iup:attribute obj (conc "DEPTH" currnode)))
+	  (node-title (iup:attribute obj (conc "TITLE" currnode))))
+      ;; (display (conc "\n   "currnode "        " nodenum "       " depth "         " node-depth "          " node-title "         " path))
+      (if (> currnode nodenum)
+	  path
+	  (if (not node-depth) ;; #f if we are out of nodes
+	      '()
+	      (let ((ndepth (string->number node-depth)))
+		(if (eq? ndepth depth)
+		    ;; This next is the match condition depth == node-depth
+		    (if (eq? currnode nodenum)
+			(begin
+			  ;; (display " <X>")
+			  (append path (list node-title)))
+			(loop (+ currnode 1)
+			      (+ depth 1)
+			      (append path (list node-title))))
+		    ;; didn't match, reset to base path and keep looking
+		    ;; due to more iup odditys we don't reset to base
+		    (begin 
+		      ;; (display " <L>")
+		      (loop (+ 1 currnode)
+			    2
+			    (append (take path ndepth)(list node-title)))))))))))
+
+(test #f 0  (tree-find-node t '("Figures")))
+(test #f 1  (tree-find-node t '("Figures" "Other")))
+(test #f #f (tree-find-node t '("Figures" "Other"    "equilateral")))
+(test #f 3  (tree-find-node t '("Figures" "triangle" "equilateral")))
+(test #f #t (tree-add-node  t "Figures" '()))
+(test #f #t (tree-add-node  t "Figures" '("a" "b" "c")))
+(test #f 3  (tree-find-node t '("Figures" "a" "b" "c")))
+(test #f #t (tree-add-node  t "Figures" '("d" "b" "c")))
+(test #f 3  (tree-find-node t '("Figures" "d" "b" "c")))
+(test #f 6  (tree-find-node t '("Figures" "a" "b" "c")))
+(test #f #t (tree-add-node  t "Figures" '("a" "e" "c")))
+(test #f 6  (tree-find-node t '("Figures" "a" "e" "c")))
+
+(test #f '("Figures")             (tree-node->path t 0))
+(test #f '("Figures" "d")         (tree-node->path t 1))
+(test #f '("Figures" "d" "b" "c") (tree-node->path t 3))
+(test #f '("Figures" "a")         (tree-node->path t 4))
+(test #f '("Figures" "a" "b" "c")     (tree-node->path t 8)) 
+(test #f '()                      (tree-node->path t 40))
+
+(iup:main-loop)
+