1#============================================================================== 2# Demonstrates how to use a tablelist widget for displaying information about 3# children of an arbitrary widget. 4# 5# Copyright (c) 2000-2010 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) 6#============================================================================== 7 8package require tablelist_tile 5.1 9 10namespace eval demo { 11 variable dir [file dirname [info script]] 12 13 # 14 # Create two images, needed in the procedure putChildren 15 # 16 variable leafImg [image create bitmap -file [file join $dir leaf.xbm] \ 17 -background coral -foreground gray50] 18 variable compImg [image create bitmap -file [file join $dir comp.xbm] \ 19 -background yellow -foreground gray50] 20} 21 22source [file join $demo::dir config_tile.tcl] 23 24# 25# Work around the improper appearance of the tile scrollbars in the aqua theme 26# 27if {[tablelist::getCurrentTheme] eq "aqua"} { 28 interp alias {} ttk::scrollbar {} ::scrollbar 29} 30 31#------------------------------------------------------------------------------ 32# demo::displayChildren 33# 34# Displays information on the children of the widget w in a tablelist widget 35# contained in a newly created top-level widget. Returns the name of the 36# tablelist widget. 37#------------------------------------------------------------------------------ 38proc demo::displayChildren w { 39 if {![winfo exists $w]} { 40 bell 41 tk_messageBox -title "Error" -icon error -message \ 42 "Bad window path name \"$w\"" 43 return "" 44 } 45 46 # 47 # Create a top-level widget of the class DemoTop 48 # 49 set top .browseTop 50 for {set n 2} {[winfo exists $top]} {incr n} { 51 set top .browseTop$n 52 } 53 toplevel $top -class DemoTop 54 55 # 56 # Create a vertically scrolled tablelist widget with 9 dynamic-width 57 # columns and interactive sort capability within the top-level 58 # 59 set tf $top.tf 60 ttk::frame $tf 61 set tbl $tf.tbl 62 set vsb $tf.vsb 63 tablelist::tablelist $tbl \ 64 -columns {0 "Path Name" left 65 0 "Class" left 66 0 "X" right 67 0 "Y" right 68 0 "Width" right 69 0 "Height" right 70 0 "Mapped" center 71 0 "Viewable" center 72 0 "Manager" left} \ 73 -labelcommand demo::labelCmd -yscrollcommand [list $vsb set] -width 0 74 if {[$tbl cget -selectborderwidth] == 0} { 75 $tbl configure -spacing 1 76 } 77 foreach col {2 3 4 5} { 78 $tbl columnconfigure $col -sortmode integer 79 } 80 foreach col {6 7} { 81 $tbl columnconfigure $col -formatcommand demo::formatBoolean 82 } 83 ttk::scrollbar $vsb -orient vertical -command [list $tbl yview] 84 85 # 86 # When displaying the information about the children of any 87 # ancestor of the label widgets, the widths of some of the 88 # labels and thus also the widths and x coordinates of some 89 # children may change. For this reason, make sure the items 90 # will be updated after any change in the sizes of the labels 91 # 92 foreach l [$tbl labels] { 93 bind $l <Configure> [list demo::updateItemsDelayed $tbl] 94 } 95 bind $tbl <Configure> [list demo::updateItemsDelayed $tbl] 96 97 # 98 # Create a pop-up menu with two command entries; bind the script 99 # associated with its first entry to the <Double-1> event, too 100 # 101 set menu $top.menu 102 menu $menu -tearoff no 103 $menu add command -label "Display Children" \ 104 -command [list demo::putChildrenOfSelWidget $tbl] 105 $menu add command -label "Display Config" \ 106 -command [list demo::dispConfigOfSelWidget $tbl] 107 set bodyTag [$tbl bodytag] 108 bind $bodyTag <Double-1> [list demo::putChildrenOfSelWidget $tbl] 109 bind $bodyTag <<Button3>> [bind TablelistBody <Button-1>] 110 bind $bodyTag <<Button3>> +[bind TablelistBody <ButtonRelease-1>] 111 bind $bodyTag <<Button3>> +[list demo::postPopupMenu $top %X %Y] 112 113 # 114 # Create three buttons within a tile frame child of the top-level widget 115 # 116 set bf $top.bf 117 ttk::frame $bf 118 set b1 $bf.b1 119 set b2 $bf.b2 120 set b3 $bf.b3 121 ttk::button $b1 -text "Refresh" 122 ttk::button $b2 -text "Parent" 123 ttk::button $b3 -text "Close" -command [list destroy $top] 124 125 # 126 # Manage the widgets 127 # 128 grid $tbl -row 0 -column 0 -sticky news 129 grid $vsb -row 0 -column 1 -sticky ns 130 grid rowconfigure $tf 0 -weight 1 131 grid columnconfigure $tf 0 -weight 1 132 pack $b1 $b2 $b3 -side left -expand yes -pady 10 133 pack $bf -side bottom -fill x 134 pack $tf -side top -expand yes -fill both 135 136 # 137 # Populate the tablelist with the data of the given widget's children 138 # 139 putChildren $w $tbl 140 return $tbl 141} 142 143#------------------------------------------------------------------------------ 144# demo::putChildren 145# 146# Outputs the data of the children of the widget w into the tablelist widget 147# tbl. 148#------------------------------------------------------------------------------ 149proc demo::putChildren {w tbl} { 150 # 151 # The following check is necessary because this procedure 152 # is also invoked by the "Refresh" and "Parent" buttons 153 # 154 if {![winfo exists $w]} { 155 bell 156 set choice [tk_messageBox -title "Error" -icon warning \ 157 -message "Bad window path name \"$w\" -- replacing\ 158 it with nearest existent ancestor" \ 159 -type okcancel -default ok -parent [winfo toplevel $tbl]] 160 if {[string compare $choice "ok"] == 0} { 161 while {![winfo exists $w]} { 162 set last [string last "." $w] 163 if {$last != 0} { 164 incr last -1 165 } 166 set w [string range $w 0 $last] 167 } 168 } else { 169 return "" 170 } 171 } 172 173 set top [winfo toplevel $tbl] 174 wm title $top "Children of the [winfo class $w] Widget \"$w\"" 175 176 $tbl resetsortinfo 177 $tbl delete 0 end 178 179 # 180 # Display the data of the children of the 181 # widget w in the tablelist widget tbl 182 # 183 variable leafImg 184 variable compImg 185 foreach c [winfo children $w] { 186 # 187 # Insert the data of the current child into the tablelist widget 188 # 189 set item {} 190 lappend item $c [winfo class $c] [winfo x $c] [winfo y $c] \ 191 [winfo width $c] [winfo height $c] [winfo ismapped $c] \ 192 [winfo viewable $c] [winfo manager $c] 193 $tbl insert end $item 194 195 # 196 # Insert an image into the first cell of the row 197 # 198 if {[llength [winfo children $c]] == 0} { 199 $tbl cellconfigure end,0 -image $leafImg 200 } else { 201 $tbl cellconfigure end,0 -image $compImg 202 } 203 } 204 205 # 206 # Configure the "Refresh" and "Parent" buttons 207 # 208 $top.bf.b1 configure -command [list demo::putChildren $w $tbl] 209 set b2 $top.bf.b2 210 set p [winfo parent $w] 211 if {[string compare $p ""] == 0} { 212 $b2 configure -state disabled 213 } else { 214 $b2 configure -state normal -command [list demo::putChildren $p $tbl] 215 } 216} 217 218#------------------------------------------------------------------------------ 219# demo::formatBoolean 220# 221# Returns "yes" or "no", according to the specified boolean value. 222#------------------------------------------------------------------------------ 223proc demo::formatBoolean val { 224 return [expr {$val ? "yes" : "no"}] 225} 226 227#------------------------------------------------------------------------------ 228# demo::labelCmd 229# 230# Sorts the contents of the tablelist widget tbl by its col'th column and makes 231# sure the items will be updated 500 ms later (because one of the items might 232# refer to a canvas containing the arrow that displays the sort order). 233#------------------------------------------------------------------------------ 234proc demo::labelCmd {tbl col} { 235 tablelist::sortByColumn $tbl $col 236 updateItemsDelayed $tbl 237} 238 239#------------------------------------------------------------------------------ 240# demo::updateItemsDelayed 241# 242# Arranges for the items of the tablelist widget tbl to be updated 500 ms later. 243#------------------------------------------------------------------------------ 244proc demo::updateItemsDelayed tbl { 245 # 246 # Schedule the demo::updateItems command for execution 247 # 500 ms later, but only if it is not yet pending 248 # 249 if {[string compare [$tbl attrib afterId] ""] == 0} { 250 $tbl attrib afterId [after 500 [list demo::updateItems $tbl]] 251 } 252} 253 254#------------------------------------------------------------------------------ 255# demo::updateItems 256# 257# Updates the items of the tablelist widget tbl. 258#------------------------------------------------------------------------------ 259proc demo::updateItems tbl { 260 # 261 # Reset the tablelist's "afterId" attribute 262 # 263 $tbl attrib afterId "" 264 265 # 266 # Update the items 267 # 268 set rowCount [$tbl size] 269 for {set row 0} {$row < $rowCount} {incr row} { 270 set c [$tbl cellcget $row,0 -text] 271 if {![winfo exists $c]} { 272 continue 273 } 274 275 set item {} 276 lappend item $c [winfo class $c] [winfo x $c] [winfo y $c] \ 277 [winfo width $c] [winfo height $c] [winfo ismapped $c] \ 278 [winfo viewable $c] [winfo manager $c] 279 $tbl rowconfigure $row -text $item 280 } 281 282 # 283 # Repeat the last sort operation (if any) 284 # 285 $tbl refreshsorting 286} 287 288#------------------------------------------------------------------------------ 289# demo::putChildrenOfSelWidget 290# 291# Outputs the data of the children of the selected widget into the tablelist 292# widget tbl. 293#------------------------------------------------------------------------------ 294proc demo::putChildrenOfSelWidget tbl { 295 set w [$tbl cellcget [$tbl curselection],0 -text] 296 if {![winfo exists $w]} { 297 bell 298 tk_messageBox -title "Error" -icon error -message \ 299 "Bad window path name \"$w\"" -parent [winfo toplevel $tbl] 300 return "" 301 } 302 303 if {[llength [winfo children $w]] == 0} { 304 bell 305 } else { 306 putChildren $w $tbl 307 } 308} 309 310#------------------------------------------------------------------------------ 311# demo::dispConfigOfSelWidget 312# 313# Displays the configuration options of the selected widget within the 314# tablelist tbl in a tablelist widget contained in a newly created top-level 315# widget. 316#------------------------------------------------------------------------------ 317proc demo::dispConfigOfSelWidget tbl { 318 demo::displayConfig [$tbl cellcget [$tbl curselection],0 -text] 319} 320 321#------------------------------------------------------------------------------ 322# demo::postPopupMenu 323# 324# Posts the pop-up menu $top.menu at the given screen position. Before posting 325# the menu, the procedure enables/disables its first entry, depending upon 326# whether the selected widget has children or not. 327#------------------------------------------------------------------------------ 328proc demo::postPopupMenu {top rootX rootY} { 329 set tbl $top.tf.tbl 330 set w [$tbl cellcget [$tbl curselection],0 -text] 331 if {![winfo exists $w]} { 332 bell 333 tk_messageBox -title "Error" -icon error -message \ 334 "Bad window path name \"$w\"" -parent $top 335 return "" 336 } 337 338 set menu $top.menu 339 if {[llength [winfo children $w]] == 0} { 340 $menu entryconfigure 0 -state disabled 341 } else { 342 $menu entryconfigure 0 -state normal 343 } 344 345 tk_popup $menu $rootX $rootY 346} 347 348#------------------------------------------------------------------------------ 349 350if {$tcl_interactive} { 351 return "\nTo display information about the children of an arbitrary\ 352 widget, enter\n\n\tdemo::displayChildren <widgetName>\n" 353} else { 354 wm withdraw . 355 tk_messageBox -title $argv0 -icon warning -message \ 356 "Please source this script into\nan interactive wish session" 357 exit 1 358} 359