1#==============================================================================
2# Demonstrates how to use a tablelist widget for displaying and editing the
3# configuration options of an arbitrary widget.
4#
5# Copyright (c) 2000-2010  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
6#==============================================================================
7
8package require tablelist 5.1
9
10namespace eval demo {
11    #
12    # Get the current windowing system ("x11", "win32", "classic", or "aqua")
13    # and add some entries to the Tk option database for the following
14    # widget hierarchy within a top-level widget of the class DemoTop:
15    #
16    # Name		Class
17    # -----------------------------
18    # tf		Frame
19    #   tbl		  Tabellist
20    #   vsb, hsb	  Scrollbar
21    # bf		Frame
22    #   b1, b2, b3	  Button
23    #
24    variable winSys
25    if {[catch {tk windowingsystem} winSys] != 0} {
26	switch $::tcl_platform(platform) {
27	    unix	{ set winSys x11 }
28	    windows	{ set winSys win32 }
29	    macintosh	{ set winSys classic }
30	}
31    }
32    if {[string compare $winSys "x11"] == 0} {
33	#
34	# Create the font TkDefaultFont if not yet present
35	#
36	catch {font create TkDefaultFont -family Helvetica -size -12}
37
38	option add *DemoTop*Font			TkDefaultFont
39	option add *DemoTop*selectBackground		#678db2
40	option add *DemoTop*selectForeground		white
41    } else {
42	option add *DemoTop.tf.borderWidth		1
43	option add *DemoTop.tf.relief			sunken
44	option add *DemoTop.tf.tbl.borderWidth		0
45	option add *DemoTop.tf.tbl.highlightThickness	0
46    }
47    if {[string compare $winSys "classic"] == 0} {
48	option add *DemoTop*background			#dedede
49    }
50    option add *DemoTop.tf.tbl.background		gray98
51    option add *DemoTop.tf.tbl.stripeBackground		#e0e8f0
52    option add *DemoTop.tf.tbl*Entry.background		white
53    option add *DemoTop.tf.tbl.setGrid			yes
54    option add *DemoTop.bf.Button.width			10
55}
56
57#------------------------------------------------------------------------------
58# demo::displayConfig
59#
60# Displays the configuration options of the widget w in a tablelist widget
61# contained in a newly created top-level widget.  Returns the name of the
62# tablelist widget.
63#------------------------------------------------------------------------------
64proc demo::displayConfig w {
65    if {![winfo exists $w]} {
66	bell
67	tk_messageBox -title "Error" -icon error -message \
68	    "Bad window path name \"$w\""
69	return ""
70    }
71
72    #
73    # Create a top-level widget of the class DemoTop
74    #
75    set top .configTop
76    for {set n 2} {[winfo exists $top]} {incr n} {
77	set top .configTop$n
78    }
79    toplevel $top -class DemoTop
80    wm title $top "Configuration Options of the [winfo class $w] Widget \"$w\""
81
82    #
83    # Create a scrolled tablelist widget with 5 dynamic-width
84    # columns and interactive sort capability within the top-level
85    #
86    set tf $top.tf
87    frame $tf
88    set tbl $tf.tbl
89    set vsb $tf.vsb
90    set hsb $tf.hsb
91    tablelist::tablelist $tbl \
92	-columns {0 "Command-Line Name"
93		  0 "Database/Alias Name"
94		  0 "Database Class"
95		  0 "Default Value"
96		  0 "Current Value"} \
97	-labelcommand tablelist::sortByColumn -sortcommand demo::compareAsSet \
98	-editendcommand demo::applyValue -height 15 -width 100 -stretch all \
99	-xscrollcommand [list $hsb set] -yscrollcommand [list $vsb set]
100    if {[$tbl cget -selectborderwidth] == 0} {
101	$tbl configure -spacing 1
102    }
103    $tbl columnconfigure 3 -maxwidth 30
104    $tbl columnconfigure 4 -maxwidth 30 -editable yes
105    scrollbar $vsb -orient vertical   -command [list $tbl yview]
106    scrollbar $hsb -orient horizontal -command [list $tbl xview]
107
108    #
109    # Create three buttons within a frame child of the top-level widget
110    #
111    set bf $top.bf
112    frame $bf
113    set b1 $bf.b1
114    set b2 $bf.b2
115    set b3 $bf.b3
116    button $b1 -text "Refresh"     -command [list demo::putConfig $w $tbl]
117    button $b2 -text "Sort as Set" -command [list $tbl sort]
118    button $b3 -text "Close"       -command [list destroy $top]
119
120    #
121    # Manage the widgets
122    #
123    grid $tbl -row 0 -column 0 -sticky news
124    grid $vsb -row 0 -column 1 -sticky ns
125    grid $hsb -row 1 -column 0 -sticky ew
126    grid rowconfigure    $tf 0 -weight 1
127    grid columnconfigure $tf 0 -weight 1
128    pack $b1 $b2 $b3 -side left -expand yes -pady 10
129    pack $bf -side bottom -fill x
130    pack $tf -side top -expand yes -fill both
131
132    #
133    # Populate the tablelist with the configuration options of the given widget
134    #
135    putConfig $w $tbl
136    return $tbl
137}
138
139#------------------------------------------------------------------------------
140# demo::putConfig
141#
142# Outputs the configuration options of the widget w into the tablelist widget
143# tbl.
144#------------------------------------------------------------------------------
145proc demo::putConfig {w tbl} {
146    if {![winfo exists $w]} {
147	bell
148	tk_messageBox -title "Error" -icon error -message \
149	    "Bad window path name \"$w\"" -parent [winfo toplevel $tbl]
150	return ""
151    }
152
153    #
154    # Display the configuration options of w in the tablelist widget tbl
155    #
156    $tbl delete 0 end
157    foreach configSet [$w configure] {
158	#
159	# Insert the list configSet into the tablelist widget
160	#
161	$tbl insert end $configSet
162
163	if {[llength $configSet] == 2} {
164	    $tbl rowconfigure end -foreground gray50 -selectforeground gray75
165	    $tbl cellconfigure end -editable no
166	} else {
167	    #
168	    # Change the colors of the first and last cell of the row
169	    # if the current value is different from the default one
170	    #
171	    set default [lindex $configSet 3]
172	    set current [lindex $configSet 4]
173	    if {[string compare $default $current] != 0} {
174		foreach col {0 4} {
175		    $tbl cellconfigure end,$col \
176			 -foreground red -selectforeground yellow
177		}
178	    }
179	}
180    }
181
182    $tbl sortbycolumn 0
183    $tbl activate 0
184    $tbl attrib widget $w
185}
186
187#------------------------------------------------------------------------------
188# demo::compareAsSet
189#
190# Compares two items of a tablelist widget used to display the configuration
191# options of an arbitrary widget.  The item in which the current value is
192# different from the default one is considered to be less than the other; if
193# both items fulfil this condition or its negation then string comparison is
194# applied to the two option names.
195#------------------------------------------------------------------------------
196proc demo::compareAsSet {item1 item2} {
197    foreach {opt1 dbName1 dbClass1 default1 current1} $item1 \
198	    {opt2 dbName2 dbClass2 default2 current2} $item2 {
199	set changed1 [expr {[string compare $default1 $current1] != 0}]
200	set changed2 [expr {[string compare $default2 $current2] != 0}]
201	if {$changed1 == $changed2} {
202	    return [string compare $opt1 $opt2]
203	} elseif {$changed1} {
204	    return -1
205	} else {
206	    return 1
207	}
208    }
209}
210
211#------------------------------------------------------------------------------
212# demo::applyValue
213#
214# Applies the new value of the configuraton option contained in the given row
215# of the tablelist widget tbl to the widget whose options are displayed in it,
216# and updates the colors of the first and last cell of the row.
217#------------------------------------------------------------------------------
218proc demo::applyValue {tbl row col text} {
219    #
220    # Try to apply the new value of the option contained in
221    # the given row to the widget whose options are displayed
222    # in the tablelist; reject the value if the attempt fails
223    #
224    set w [$tbl attrib widget]
225    set opt [$tbl cellcget $row,0 -text]
226    if {[catch {$w configure $opt $text} result] != 0} {
227	bell
228	tk_messageBox -title "Error" -icon error -message $result \
229	    -parent [winfo toplevel $tbl]
230	$tbl rejectinput
231	return ""
232    }
233
234    #
235    # Replace the new option value with its canonical form and
236    # update the colors of the first and last cell of the row
237    #
238    set text [$w cget $opt]
239    set default [$tbl cellcget $row,3 -text]
240    if {[string compare $default $text] == 0} {
241	foreach col {0 4} {
242	    $tbl cellconfigure $row,$col \
243		 -foreground "" -selectforeground ""
244	}
245    } else {
246	foreach col {0 4} {
247	    $tbl cellconfigure $row,$col \
248		 -foreground red -selectforeground yellow
249	}
250    }
251
252    return $text
253}
254
255#------------------------------------------------------------------------------
256
257if {$tcl_interactive} {
258    return "\nTo display the configuration options of an arbitrary\
259	    widget, enter\n\n\tdemo::displayConfig <widgetName>\n"
260} else {
261    wm withdraw .
262    tk_messageBox -title $argv0 -icon warning -message \
263	"Please source this script into\nan interactive wish session"
264    exit 1
265}
266