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