Added a demo of how to do a multi-column sortable listbox.

2 files changed, 101 insertions, 1 deletions

diff --git a/library/demos/mclist.tcl b/library/demos/mclist.tcl
new file mode 100644
index 0000000..ed2f55a
--- /dev/null
+++ b/library/demos/mclist.tcl
@@ -0,0 +1,98 @@
+# mclist.tcl --
+#
+# This demonstration script creates a toplevel window containing a Ttk
+# tree widget configured as a multi-column listbox.
+#
+# RCS: @(#) $Id: mclist.tcl,v 1.1 2007/11/02 23:48:11 dkf Exp $
+
+if {![info exists widgetDemo]} {
+    error "This script should be run from the \"widget\" demo."
+}
+
+package require Tk
+package require Ttk
+
+set w .mclist
+catch {destroy $w}
+toplevel $w
+wm title $w "Multi-Column List"
+wm iconname $w "mclist"
+positionWindow $w
+
+## Explanatory text
+ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -text "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which can be configured to display multiple columns of informational data without displaying the tree itself. This is a simple way to build a listbox that has multiple columns. Clicking on the heading for a column will sort the data by that column. You can also change the width of the columns by dragging the boundary between them."
+pack $w.msg -fill x
+
+## See Code / Dismiss
+pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
+
+ttk::frame $w.container
+ttk::treeview $w.tree -columns {country capital currency} -show headings \
+    -yscroll "$w.vsb set" -xscroll "$w.hsb set"
+if {[tk windowingsystem] ne "aqua"} {
+    ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview"
+    ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
+} else {
+    scrollbar $w.vsb -orient vertical -command "$w.tree yview"
+    scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
+}
+pack $w.container -fill both -expand 1
+grid $w.tree $w.vsb -in $w.container -sticky nsew
+grid $w.hsb         -in $w.container -sticky nsew
+grid column $w.container 0 -weight 1
+grid row    $w.container 0 -weight 1
+
+## The data we're going to insert
+set data {
+    Argentina		{Buenos Aires}		ARS
+    Australia		Canberra		AUD
+    Brazil		Brazilia		BRL
+    Canada		Ottawa			CAD
+    China		Beijing			CNY
+    France		Paris			EUR
+    Germany		Berlin			EUR
+    India		{New Delhi}		INR
+    Italy		Rome			EUR
+    Japan		Tokyo			JPY
+    Mexico		{Mexico City}		MXN
+    Russia		Moscow			RUB
+    {South Africa}	Pretoria		ZAR
+    {United Kingdom}	London			GBP
+    {United States}	{Washington, D.C.}	USD
+}
+
+## Code to insert the data nicely
+set font [ttk::style lookup [$w.tree cget -style] -font]
+foreach col {country capital currency} name {Country Capital Currency} {
+    $w.tree heading $col -command [list SortBy $w.tree $col 0] -text $name
+    $w.tree column $col -width [font measure $font $name]
+}
+foreach {country capital currency} $data {
+    $w.tree insert {} end -values [list $country $capital $currency]
+    foreach col {country capital currency} {
+	set len [font measure $font "[set $col]  "]
+	if {[$w.tree column $col -width] < $len} {
+	    $w.tree column $col -width $len
+	}
+    }
+}
+
+## Code to do the sorting of the tree contents when clicked on
+proc SortBy {tree col direction} {
+    # Build something we can sort
+    set data {}
+    foreach row [$tree children {}] {
+	lappend data [list [$tree set $row $col] $row]
+    }
+
+    set dir [expr {$direction ? "-decreasing" : "-increasing"}]
+    set r -1
+
+    # Now reshuffle the rows into the sorted order
+    foreach info [lsort -dictionary -index 0 $dir $data] {
+	$tree move [lindex $info 1] {} [incr r]
+    }
+
+    # Switch the heading so that it will sort in the opposite direction
+    $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]]
+}
diff --git a/library/demos/widget b/library/demos/widget
index 333e29a..6bcb0c6 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -10,7 +10,7 @@ exec wish "$0" "$@"
 # separate ".tcl" files is this directory, which are sourced by this script as
 # needed.
 #
-# RCS: @(#) $Id: widget,v 1.44 2007/11/01 11:34:00 das Exp $
+# RCS: @(#) $Id: widget,v 1.45 2007/11/02 23:48:11 dkf Exp $
 
 package require Tcl	8.5
 package require Tk	8.5
@@ -329,6 +329,8 @@ addFormattedText {
     @@demo colors	Colors: change the color scheme for the application
     @@demo sayings	A collection of famous and infamous sayings
     @@new
+    @@demo mclist	A multi-column list of countries
+    @@new
     @@demo tree		A directory browser tree
 
     @@subtitle	Entries, Spin-boxes and Combo-boxes