1# mclist.tcl --
2#
3# This demonstration script creates a toplevel window containing a Ttk
4# tree widget configured as a multi-column listbox.
5#
6# RCS: @(#) $Id$
7
8if {![info exists widgetDemo]} {
9    error "This script should be run from the \"widget\" demo."
10}
11
12package require Tk
13package require Ttk
14
15set w .mclist
16catch {destroy $w}
17toplevel $w
18wm title $w "Multi-Column List"
19wm iconname $w "mclist"
20positionWindow $w
21
22## Explanatory text
23ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -padding {10 2 10 6} -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."
24pack $w.msg -fill x
25
26## See Code / Dismiss
27pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
28
29ttk::frame $w.container
30ttk::treeview $w.tree -columns {country capital currency} -show headings \
31    -yscroll "$w.vsb set" -xscroll "$w.hsb set"
32if {[tk windowingsystem] ne "aqua"} {
33    ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview"
34    ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
35} else {
36    scrollbar $w.vsb -orient vertical -command "$w.tree yview"
37    scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
38}
39pack $w.container -fill both -expand 1
40grid $w.tree $w.vsb -in $w.container -sticky nsew
41grid $w.hsb         -in $w.container -sticky nsew
42grid column $w.container 0 -weight 1
43grid row    $w.container 0 -weight 1
44
45## The data we're going to insert
46set data {
47    Argentina		{Buenos Aires}		ARS
48    Australia		Canberra		AUD
49    Brazil		Brazilia		BRL
50    Canada		Ottawa			CAD
51    China		Beijing			CNY
52    France		Paris			EUR
53    Germany		Berlin			EUR
54    India		{New Delhi}		INR
55    Italy		Rome			EUR
56    Japan		Tokyo			JPY
57    Mexico		{Mexico City}		MXN
58    Russia		Moscow			RUB
59    {South Africa}	Pretoria		ZAR
60    {United Kingdom}	London			GBP
61    {United States}	{Washington, D.C.}	USD
62}
63
64## Code to insert the data nicely
65set font [ttk::style lookup [$w.tree cget -style] -font]
66foreach col {country capital currency} name {Country Capital Currency} {
67    $w.tree heading $col -command [list SortBy $w.tree $col 0] -text $name
68    $w.tree column $col -width [font measure $font $name]
69}
70foreach {country capital currency} $data {
71    $w.tree insert {} end -values [list $country $capital $currency]
72    foreach col {country capital currency} {
73	set len [font measure $font "[set $col]  "]
74	if {[$w.tree column $col -width] < $len} {
75	    $w.tree column $col -width $len
76	}
77    }
78}
79
80## Code to do the sorting of the tree contents when clicked on
81proc SortBy {tree col direction} {
82    # Determine currently sorted column and its sort direction
83    foreach c {country capital currency} {
84	set s [$tree heading $c state]
85	if {("selected" in $s || "alternate" in $s) && $col ne $c} {
86	    # Sorted column has changed
87	    $tree heading $c state {!selected !alternate !user1}
88	    set direction [expr {"alternate" in $s}]
89	}
90    }
91
92    # Build something we can sort
93    set data {}
94    foreach row [$tree children {}] {
95	lappend data [list [$tree set $row $col] $row]
96    }
97
98    set dir [expr {$direction ? "-decreasing" : "-increasing"}]
99    set r -1
100
101    # Now reshuffle the rows into the sorted order
102    foreach info [lsort -dictionary -index 0 $dir $data] {
103	$tree move [lindex $info 1] {} [incr r]
104    }
105
106    # Switch the heading so that it will sort in the opposite direction
107    $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]] \
108	state [expr {$direction?"!selected alternate":"selected !alternate"}]
109    if {[tk windowingsystem] eq "aqua"} {
110	# Aqua theme displays native sort arrows when user1 state is set
111	$tree heading $col state "user1"
112    }
113}
114