From 6137f8797b9b058e0cf9b93cf6b8708e42aeacde Mon Sep 17 00:00:00 2001 From: treectrl Date: Thu, 30 Nov 2006 02:41:38 +0000 Subject: Whitespace police. --- demos/biglist.tcl | 672 ++++++++++++++-------------- demos/bitmaps.tcl | 122 ++--- demos/explorer.tcl | 1062 ++++++++++++++++++++++---------------------- demos/firefox.tcl | 796 ++++++++++++++++----------------- demos/help.tcl | 650 +++++++++++++-------------- demos/imovie.tcl | 248 +++++------ demos/layout.tcl | 270 +++++------ demos/mailwasher.tcl | 370 +++++++-------- demos/outlook-folders.tcl | 256 +++++------ demos/outlook-newgroup.tcl | 746 +++++++++++++++---------------- demos/random.tcl | 702 ++++++++++++++--------------- demos/textvariable.tcl | 116 ++--- demos/www-options.tcl | 540 +++++++++++----------- 13 files changed, 3275 insertions(+), 3275 deletions(-) diff --git a/demos/biglist.tcl b/demos/biglist.tcl index 2353ec0..f37e179 100644 --- a/demos/biglist.tcl +++ b/demos/biglist.tcl @@ -1,409 +1,409 @@ -# RCS: @(#) $Id: biglist.tcl,v 1.11 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: biglist.tcl,v 1.12 2006/11/30 02:41:38 treectrl Exp $ set ::clip 1 proc DemoBigList {} { - global BigList + global BigList - set T [DemoList] + set T [DemoList] - # - # Configure the treectrl widget - # + # + # Configure the treectrl widget + # - $T configure -selectmode extended \ - -showroot no -showbuttons no -showlines no \ - -showrootlines no + $T configure -selectmode extended \ + -showroot no -showbuttons no -showlines no \ + -showrootlines no if {$::clip} { - $T configure -xscrollincrement 4 -yscrollincrement 4 + $T configure -xscrollincrement 4 -yscrollincrement 4 } else { - # Hide the borders because child windows appear on top of them - $T configure -borderwidth 0 -highlightthickness 0 + # Hide the borders because child windows appear on top of them + $T configure -borderwidth 0 -highlightthickness 0 } - # - # Create columns - # - - $T column create -expand yes -text Item -itembackground {#F7F7F7} -tags colItem - $T column create -text "Item ID" -justify center -itembackground {} -tags colID - $T column create -text "Parent ID" -justify center -itembackground {} -tags colParent - - # Specify the column that will display the heirarchy buttons and lines - $T configure -treecolumn colItem - - # - # Create elements - # - - set BigList(bg) $::SystemButtonFace - set outline gray70 - - $T element create eRectTop.e rect -outline $outline -fill $BigList(bg) \ - -draw {yes open no {}} -outlinewidth 1 -open es - $T element create eRectTop.we rect -outline $outline -fill $BigList(bg) \ - -draw {yes open no {}} -outlinewidth 1 -open wes - $T element create eRectTop.w rect -outline $outline -fill $BigList(bg) \ - -draw {yes open no {}} -outlinewidth 1 -open ws - $T element create eRectBottom rect -outline $outline -fill $BigList(bg) \ - -outlinewidth 1 -open n - - # Title - $T element create elemBorderTitle border -relief {sunken open raised {}} -thickness 1 \ - -filled yes -background $::SystemButtonFace - $T element create elemTxtTitle text \ - -font [list "[$T cget -font] bold"] - - # Citizen - $T element create elemRectSel rect -showfocus no \ - -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] - $T element create elemTxtItem text \ - -fill [list $::SystemHighlightText {selected focus}] - $T element create elemTxtName text \ - -fill [list $::SystemHighlightText {selected focus} blue {}] - - # Citizen info - $T element create elemWindow window + # + # Create columns + # + + $T column create -expand yes -text Item -itembackground {#F7F7F7} -tags colItem + $T column create -text "Item ID" -justify center -itembackground {} -tags colID + $T column create -text "Parent ID" -justify center -itembackground {} -tags colParent + + # Specify the column that will display the heirarchy buttons and lines + $T configure -treecolumn colItem + + # + # Create elements + # + + set BigList(bg) $::SystemButtonFace + set outline gray70 + + $T element create eRectTop.e rect -outline $outline -fill $BigList(bg) \ + -draw {yes open no {}} -outlinewidth 1 -open es + $T element create eRectTop.we rect -outline $outline -fill $BigList(bg) \ + -draw {yes open no {}} -outlinewidth 1 -open wes + $T element create eRectTop.w rect -outline $outline -fill $BigList(bg) \ + -draw {yes open no {}} -outlinewidth 1 -open ws + $T element create eRectBottom rect -outline $outline -fill $BigList(bg) \ + -outlinewidth 1 -open n + + # Title + $T element create elemBorderTitle border -relief {sunken open raised {}} -thickness 1 \ + -filled yes -background $::SystemButtonFace + $T element create elemTxtTitle text \ + -font [list "[$T cget -font] bold"] + + # Citizen + $T element create elemRectSel rect -showfocus no \ + -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] + $T element create elemTxtItem text \ + -fill [list $::SystemHighlightText {selected focus}] + $T element create elemTxtName text \ + -fill [list $::SystemHighlightText {selected focus} blue {}] + + # Citizen info + $T element create elemWindow window if {$::clip} { $T element configure elemWindow -clip yes } - # - # Create styles using the elements - # - - set S [$T style create styTitle] - $T style elements $S {elemBorderTitle elemTxtTitle} - $T style layout $S elemTxtTitle -expand news - $T style layout $S elemBorderTitle -detach yes -indent no -iexpand xy - - set S [$T style create styItem] - $T style elements $S {eRectTop.e elemRectSel elemTxtItem elemTxtName} - $T style layout $S eRectTop.e -detach yes -indent no -iexpand xy - $T style layout $S elemTxtItem -expand ns - $T style layout $S elemTxtName -expand ns -padx {20} - $T style layout $S elemRectSel -detach yes -indent no -iexpand xy - - set S [$T style create styID] - $T style elements $S {eRectTop.we elemRectSel elemTxtItem} - $T style layout $S eRectTop.we -detach yes -indent yes -iexpand xy - $T style layout $S elemTxtItem -padx 6 -expand ns - $T style layout $S elemRectSel -detach yes -indent no -iexpand xy - - set S [$T style create styParent] - $T style elements $S {eRectTop.w elemRectSel elemTxtItem} - $T style layout $S eRectTop.w -detach yes -indent yes -iexpand xy - $T style layout $S elemTxtItem -padx 6 -expand ns - $T style layout $S elemRectSel -detach yes -indent no -iexpand xy - - set S [$T style create styCitizen] - $T style elements $S {eRectBottom elemWindow} - $T style layout $S eRectBottom -detach yes -indent no -iexpand xy - $T style layout $S elemWindow -pady {0 1} - - # - # Create 10000 items. Each of these items will hold 10 child items. - # - - set index 1 - foreach I [$T item create -count 10000 -parent root -button yes -open no \ - -height 20 -tags title] { - set BigList(titleIndex,$I) $index - incr index 10 - } - - # This binding will add child items to an item just before it is expanded. - $T notify bind $T { - BigListExpandBefore %T %I - } - - # This binding will assign styles to items when they are displayed and - # clear the styles when they are no longer displayed. - $T notify bind $T { - BigListItemVisibility %T %v %h + # + # Create styles using the elements + # + + set S [$T style create styTitle] + $T style elements $S {elemBorderTitle elemTxtTitle} + $T style layout $S elemTxtTitle -expand news + $T style layout $S elemBorderTitle -detach yes -indent no -iexpand xy + + set S [$T style create styItem] + $T style elements $S {eRectTop.e elemRectSel elemTxtItem elemTxtName} + $T style layout $S eRectTop.e -detach yes -indent no -iexpand xy + $T style layout $S elemTxtItem -expand ns + $T style layout $S elemTxtName -expand ns -padx {20} + $T style layout $S elemRectSel -detach yes -indent no -iexpand xy + + set S [$T style create styID] + $T style elements $S {eRectTop.we elemRectSel elemTxtItem} + $T style layout $S eRectTop.we -detach yes -indent yes -iexpand xy + $T style layout $S elemTxtItem -padx 6 -expand ns + $T style layout $S elemRectSel -detach yes -indent no -iexpand xy + + set S [$T style create styParent] + $T style elements $S {eRectTop.w elemRectSel elemTxtItem} + $T style layout $S eRectTop.w -detach yes -indent yes -iexpand xy + $T style layout $S elemTxtItem -padx 6 -expand ns + $T style layout $S elemRectSel -detach yes -indent no -iexpand xy + + set S [$T style create styCitizen] + $T style elements $S {eRectBottom elemWindow} + $T style layout $S eRectBottom -detach yes -indent no -iexpand xy + $T style layout $S elemWindow -pady {0 1} + + # + # Create 10000 items. Each of these items will hold 10 child items. + # + + set index 1 + foreach I [$T item create -count 10000 -parent root -button yes -open no \ + -height 20 -tags title] { + set BigList(titleIndex,$I) $index + incr index 10 + } + + # This binding will add child items to an item just before it is expanded. + $T notify bind $T { + BigListExpandBefore %T %I + } + + # This binding will assign styles to items when they are displayed and + # clear the styles when they are no longer displayed. + $T notify bind $T { + BigListItemVisibility %T %v %h + } + + set BigList(freeWindows) {} + set BigList(nextWindowId) 0 + set BigList(prev) "" + + BigListGetWindowHeight $T + if {$::tile} { + bind DemoBigList <> { + BigListGetWindowHeight [DemoList] + if {[[DemoList] item id {first visible tag info}] ne ""} { + [DemoList] item conf {tag info} -height $BigList(windowHeight) + } } + } - set BigList(freeWindows) {} - set BigList(nextWindowId) 0 - set BigList(prev) "" - - BigListGetWindowHeight $T - if {$::tile} { - bind DemoBigList <> { - BigListGetWindowHeight [DemoList] - if {[[DemoList] item id {first visible tag info}] ne ""} { - [DemoList] item conf {tag info} -height $BigList(windowHeight) - } - } - } - - bind DemoBigList { - if {[lindex [%W identify %x %y] 0] eq "header"} { - TreeCtrl::DoubleButton1 %W %x %y - } else { - BigListButton1 %W %x %y - } - break - } - bind DemoBigList { - BigListButton1 %W %x %y - break - } - bind DemoBigList { - BigListMotion %W %x %y - } - - bind DemoBigListChildWindow { - set x [expr {%X - [winfo rootx [DemoList]]}] - set y [expr {%Y - [winfo rooty [DemoList]]}] - BigListMotion [DemoList] $x $y + bind DemoBigList { + if {[lindex [%W identify %x %y] 0] eq "header"} { + TreeCtrl::DoubleButton1 %W %x %y + } else { + BigListButton1 %W %x %y } - - bindtags $T [list $T DemoBigList TreeCtrl [winfo toplevel $T] all] - - return + break + } + bind DemoBigList { + BigListButton1 %W %x %y + break + } + bind DemoBigList { + BigListMotion %W %x %y + } + + bind DemoBigListChildWindow { + set x [expr {%X - [winfo rootx [DemoList]]}] + set y [expr {%Y - [winfo rooty [DemoList]]}] + BigListMotion [DemoList] $x $y + } + + bindtags $T [list $T DemoBigList TreeCtrl [winfo toplevel $T] all] + + return } proc BigListGetWindowHeight {T} { - global BigList - # Create a new window just to get the requested size. This will be the - # value of the item -height option for some items. - set w [BigListNewWindow $T root] - update idletasks + global BigList + # Create a new window just to get the requested size. This will be the + # value of the item -height option for some items. + set w [BigListNewWindow $T root] + update idletasks if {$::clip} { - set height [winfo reqheight [lindex [winfo children $w] 0]] + set height [winfo reqheight [lindex [winfo children $w] 0]] } else { - set height [winfo reqheight $w] + set height [winfo reqheight $w] } - # Add 1 pixel for the border - incr height - set BigList(windowHeight) $height - BigListFreeWindow $T $w - return + # Add 1 pixel for the border + incr height + set BigList(windowHeight) $height + BigListFreeWindow $T $w + return } proc BigListExpandBefore {T I} { - global BigList + global BigList + + set parent [$T item parent $I] + if {[$T item numchildren $I]} return + + # Title + if {[$T item tag expr $I title]} { + set index $BigList(titleIndex,$I) + set threats {Severe High Elevated Guarded Low} + set names1 {Bill John Jack Bob Tim Sam Mary Susan Lilian Jeff Gary + Neil Margaret} + set names2 {Smith Hobbs Baker Furst Newel Gates Marshal McNoodle + Marley} + + # Add 10 child items to this item. Each item represents 1 citizen. + # The styles will be assigned in BigListItemVisibility. + foreach I [$T item create -count 10 -parent $I -open no -button yes \ + -height 20 -tags citizen] { + set name1 [lindex $names1 [expr {int(rand() * [llength $names1])}]] + set name2 [lindex $names2 [expr {int(rand() * [llength $names2])}]] + set BigList(itemIndex,$I) $index + set BigList(name,$I) "$name1 $name2" + set BigList(threat,$I) [lindex $threats [expr {int(rand() * 5)}]] + incr index + } + return + } + + # Citizen + if {[$T item tag expr $I citizen]} { + + # Add 1 child item to this item. + # The styles will be assigned in BigListItemVisibility. + $T item create -parent $I -height $BigList(windowHeight) -tags info + } + + return +} + +proc BigListItemVisibility {T visible hidden} { + + global BigList + # Assign styles and configure elements in each item that is now + # visible on screen. + foreach I $visible { set parent [$T item parent $I] - if {[$T item numchildren $I]} return # Title if {[$T item tag expr $I title]} { - set index $BigList(titleIndex,$I) - set threats {Severe High Elevated Guarded Low} - set names1 {Bill John Jack Bob Tim Sam Mary Susan Lilian Jeff Gary - Neil Margaret} - set names2 {Smith Hobbs Baker Furst Newel Gates Marshal McNoodle - Marley} - - # Add 10 child items to this item. Each item represents 1 citizen. - # The styles will be assigned in BigListItemVisibility. - foreach I [$T item create -count 10 -parent $I -open no -button yes \ - -height 20 -tags citizen] { - set name1 [lindex $names1 [expr {int(rand() * [llength $names1])}]] - set name2 [lindex $names2 [expr {int(rand() * [llength $names2])}]] - set BigList(itemIndex,$I) $index - set BigList(name,$I) "$name1 $name2" - set BigList(threat,$I) [lindex $threats [expr {int(rand() * 5)}]] - incr index - } - return + set first $BigList(titleIndex,$I) + set last [expr {$first + 10 - 1}] + set first [format %06d $first] + set last [format %06d $last] + $T item span $I colItem 3 + $T item style set $I colItem styTitle + $T item element configure $I \ + colItem elemTxtTitle -text "Citizens $first-$last" + continue } # Citizen if {[$T item tag expr $I citizen]} { - - # Add 1 child item to this item. - # The styles will be assigned in BigListItemVisibility. - $T item create -parent $I -height $BigList(windowHeight) -tags info + set index $BigList(itemIndex,$I) + $T item style set $I colItem styItem colID styID colParent styParent + $T item element configure $I \ + colItem elemTxtItem -text "Citizen $index" + elemTxtName -textvariable ::BigList(name,$I) , \ + colParent elemTxtItem -text $parent , \ + colID elemTxtItem -text $I + continue } - return -} - -proc BigListItemVisibility {T visible hidden} { - - global BigList - - # Assign styles and configure elements in each item that is now - # visible on screen. - foreach I $visible { - set parent [$T item parent $I] - - # Title - if {[$T item tag expr $I title]} { - set first $BigList(titleIndex,$I) - set last [expr {$first + 10 - 1}] - set first [format %06d $first] - set last [format %06d $last] - $T item span $I colItem 3 - $T item style set $I colItem styTitle - $T item element configure $I \ - colItem elemTxtTitle -text "Citizens $first-$last" - continue - } - - # Citizen - if {[$T item tag expr $I citizen]} { - set index $BigList(itemIndex,$I) - $T item style set $I colItem styItem colID styID colParent styParent - $T item element configure $I \ - colItem elemTxtItem -text "Citizen $index" + elemTxtName -textvariable ::BigList(name,$I) , \ - colParent elemTxtItem -text $parent , \ - colID elemTxtItem -text $I - continue - } - - # Citizen info - if {[$T item tag expr $I info]} { - set w [BigListNewWindow $T $parent] - $T item style set $I colItem styCitizen - $T item span $I colItem 3 - $T item element configure $I colItem \ - elemWindow -window $w - } + # Citizen info + if {[$T item tag expr $I info]} { + set w [BigListNewWindow $T $parent] + $T item style set $I colItem styCitizen + $T item span $I colItem 3 + $T item element configure $I colItem \ + elemWindow -window $w } + } - # Clear the styles of each item that is no longer visible on screen. - foreach I $hidden { + # Clear the styles of each item that is no longer visible on screen. + foreach I $hidden { - # Citizen info - if {[$T item tag expr $I info]} { - # Add this window to the list of unused windows - set w [$T item element cget $I colItem elemWindow -window] - BigListFreeWindow $T $w - } - $T item style set $I colItem "" colParent "" colID "" + # Citizen info + if {[$T item tag expr $I info]} { + # Add this window to the list of unused windows + set w [$T item element cget $I colItem elemWindow -window] + BigListFreeWindow $T $w } - return + $T item style set $I colItem "" colParent "" colID "" + } + return } proc BigListNewWindow {T I} { - global BigList + global BigList - # Check the list of unused windows - if {[llength $BigList(freeWindows)]} { - set w [lindex $BigList(freeWindows) 0] - set BigList(freeWindows) [lrange $BigList(freeWindows) 1 end] + # Check the list of unused windows + if {[llength $BigList(freeWindows)]} { + set w [lindex $BigList(freeWindows) 0] + set BigList(freeWindows) [lrange $BigList(freeWindows) 1 end] if {$::clip} { - set f $w - set w [lindex [winfo children $f] 0] + set f $w + set w [lindex [winfo children $f] 0] } puts "reuse window $w" - # No unused windows exist. Create a new one. - } else { - set id [incr BigList(nextWindowId)] + # No unused windows exist. Create a new one. + } else { + set id [incr BigList(nextWindowId)] if {$::clip} { - set f [frame $T.clip$id -background blue] - set w [frame $f.frame$id -background $BigList(bg)] + set f [frame $T.clip$id -background blue] + set w [frame $f.frame$id -background $BigList(bg)] } else { - set w [frame $T.frame$id -background $BigList(bg)] + set w [frame $T.frame$id -background $BigList(bg)] } - # Name: label + entry - label $w.label1 -text "Name:" -anchor w -background $BigList(bg) - $::entryCmd $w.entry1 -width 24 - - # Threat Level: label + menubutton - label $w.label2 -text "Threat Level:" -anchor w -background $BigList(bg) - if {$::tile} { - ttk::combobox $w.mb2 -values {Severe High Elevated Guarded Low} \ - -state readonly -width [string length "Elevated"] - } else { - menubutton $w.mb2 -indicatoron yes -menu $w.mb2.m \ - -width [string length Elevated] -relief raised - menu $w.mb2.m -tearoff no - foreach label {Severe High Elevated Guarded Low} { - $w.mb2.m add radiobutton -label $label \ - -value $label \ - -command [list $w.mb2 configure -text $label] - } - } - - # Button - set message \ - "After abducting and probing these people over the last\n\ - 50 years, the only thing we've learned for certain is that\n\ - one in ten just doesn't seem to mind." - if {$::thisPlatform ne "windows"} { - set message [string map {\n ""} $message] - } - $::buttonCmd $w.b3 -text "Anal Probe Wizard..." -command [list tk_messageBox \ - -parent . -message $message -title "Anal Probe 2.0"] - - grid $w.label1 -row 0 -column 0 -sticky w -padx {0 8} - grid $w.entry1 -row 0 -column 1 -sticky w -pady 4 - grid $w.label2 -row 1 -column 0 -sticky w -padx {0 8} - grid $w.mb2 -row 1 -column 1 -sticky w -pady 4 - grid $w.b3 -row 3 -column 0 -columnspan 2 -sticky we -pady {0 4} - - AddBindTag $w DemoBigListChildWindow - AddBindTag $w TagIdentify + # Name: label + entry + label $w.label1 -text "Name:" -anchor w -background $BigList(bg) + $::entryCmd $w.entry1 -width 24 -puts "create window $w" + # Threat Level: label + menubutton + label $w.label2 -text "Threat Level:" -anchor w -background $BigList(bg) + if {$::tile} { + ttk::combobox $w.mb2 -values {Severe High Elevated Guarded Low} \ + -state readonly -width [string length "Elevated"] + } else { + menubutton $w.mb2 -indicatoron yes -menu $w.mb2.m \ + -width [string length Elevated] -relief raised + menu $w.mb2.m -tearoff no + foreach label {Severe High Elevated Guarded Low} { + $w.mb2.m add radiobutton -label $label \ + -value $label \ + -command [list $w.mb2 configure -text $label] + } } - # Tie the widgets to the global variables for this citizen - $w.entry1 configure -textvariable BigList(name,$I) - $w.mb2 configure -textvariable BigList(threat,$I) - if {!$::tile} { - foreach label {Severe High Elevated Guarded Low} { - $w.mb2.m entryconfigure $label -variable BigList(threat,$I) - } + # Button + set message \ + "After abducting and probing these people over the last\n\ + 50 years, the only thing we've learned for certain is that\n\ + one in ten just doesn't seem to mind." + if {$::thisPlatform ne "windows"} { + set message [string map {\n ""} $message] } + $::buttonCmd $w.b3 -text "Anal Probe Wizard..." -command [list tk_messageBox \ + -parent . -message $message -title "Anal Probe 2.0"] + + grid $w.label1 -row 0 -column 0 -sticky w -padx {0 8} + grid $w.entry1 -row 0 -column 1 -sticky w -pady 4 + grid $w.label2 -row 1 -column 0 -sticky w -padx {0 8} + grid $w.mb2 -row 1 -column 1 -sticky w -pady 4 + grid $w.b3 -row 3 -column 0 -columnspan 2 -sticky we -pady {0 4} + + AddBindTag $w DemoBigListChildWindow + AddBindTag $w TagIdentify + +puts "create window $w" + } + + # Tie the widgets to the global variables for this citizen + $w.entry1 configure -textvariable BigList(name,$I) + $w.mb2 configure -textvariable BigList(threat,$I) + if {!$::tile} { + foreach label {Severe High Elevated Guarded Low} { + $w.mb2.m entryconfigure $label -variable BigList(threat,$I) + } + } if {$::clip} { return $f } - return $w + return $w } proc BigListFreeWindow {T w} { - global BigList + global BigList - # Add the window to our list of free windows. DemoClear will actually - # delete the window when the demo changes. - lappend BigList(freeWindows) $w + # Add the window to our list of free windows. DemoClear will actually + # delete the window when the demo changes. + lappend BigList(freeWindows) $w puts "free window $w" - return + return } proc BigListButton1 {w x y} { - variable TreeCtrl::Priv - focus $w - set id [$w identify $x $y] - set Priv(buttonMode) "" - if {[lindex $id 0] eq "header"} { - TreeCtrl::ButtonPress1 $w $x $y - } elseif {[lindex $id 0] eq "item"} { - set item [lindex $id 1] - # click a button - if {[llength $id] != 6} { - TreeCtrl::ButtonPress1 $w $x $y - return - } - if {[$w item tag expr $item !info]} { - $w item toggle $item - } + variable TreeCtrl::Priv + focus $w + set id [$w identify $x $y] + set Priv(buttonMode) "" + if {[lindex $id 0] eq "header"} { + TreeCtrl::ButtonPress1 $w $x $y + } elseif {[lindex $id 0] eq "item"} { + set item [lindex $id 1] + # click a button + if {[llength $id] != 6} { + TreeCtrl::ButtonPress1 $w $x $y + return } - return + if {[$w item tag expr $item !info]} { + $w item toggle $item + } + } + return } proc BigListMotion {w x y} { - global BigList - set id [$w identify $x $y] - if {[lindex $id 0] eq "item"} { - set item [lindex $id 1] - if {[$w item tag expr $item !info]} { - if {$item ne $BigList(prev)} { - $w configure -cursor hand2 - set BigList(prev) $item - } - return - } + global BigList + set id [$w identify $x $y] + if {[lindex $id 0] eq "item"} { + set item [lindex $id 1] + if {[$w item tag expr $item !info]} { + if {$item ne $BigList(prev)} { + $w configure -cursor hand2 + set BigList(prev) $item + } + return } - if {$BigList(prev) ne ""} { - $w configure -cursor "" - set BigList(prev) "" - } - return + } + if {$BigList(prev) ne ""} { + $w configure -cursor "" + set BigList(prev) "" + } + return } diff --git a/demos/bitmaps.tcl b/demos/bitmaps.tcl index 787e416..fa1cf47 100644 --- a/demos/bitmaps.tcl +++ b/demos/bitmaps.tcl @@ -1,86 +1,86 @@ -# RCS: @(#) $Id: bitmaps.tcl,v 1.10 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: bitmaps.tcl,v 1.11 2006/11/30 02:41:38 treectrl Exp $ # # Demo: Bitmaps # proc DemoBitmaps {} { - set T [DemoList] + set T [DemoList] - # - # Configure the treectrl widget - # + # + # Configure the treectrl widget + # - $T configure -showroot no -showbuttons no -showlines no \ - -selectmode browse -orient horizontal -wrap "5 items" \ - -showheader no -backgroundimage sky + $T configure -showroot no -showbuttons no -showlines no \ + -selectmode browse -orient horizontal -wrap "5 items" \ + -showheader no -backgroundimage sky - # - # Create columns - # + # + # Create columns + # - $T column create -itembackground {gray90 {}} -tags C0 + $T column create -itembackground {gray90 {}} -tags C0 - # - # Create elements - # + # + # Create elements + # - $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] - $T element create elemSelTxt rect -fill [list $::SystemHighlight {selected focus}] \ - -showfocus yes - $T element create elemSelBmp rect -outline [list $::SystemHighlight {selected focus}] \ - -outlinewidth 4 - $T element create elemBmp bitmap \ - -foreground [list $::SystemHighlight {selected focus}] \ - -background linen \ - -bitmap {question {selected}} + $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] + $T element create elemSelTxt rect -fill [list $::SystemHighlight {selected focus}] \ + -showfocus yes + $T element create elemSelBmp rect -outline [list $::SystemHighlight {selected focus}] \ + -outlinewidth 4 + $T element create elemBmp bitmap \ + -foreground [list $::SystemHighlight {selected focus}] \ + -background linen \ + -bitmap {question {selected}} - # - # Create styles using the elements - # + # + # Create styles using the elements + # - set S [$T style create STYLE -orient vertical] - $T style elements $S {elemSelBmp elemBmp elemSelTxt elemTxt} - $T style layout $S elemSelBmp -union elemBmp \ - -ipadx 6 -ipady 6 - $T style layout $S elemBmp -pady {0 6} -expand we - $T style layout $S elemSelTxt -union elemTxt -ipadx 2 - $T style layout $S elemTxt -expand we + set S [$T style create STYLE -orient vertical] + $T style elements $S {elemSelBmp elemBmp elemSelTxt elemTxt} + $T style layout $S elemSelBmp -union elemBmp \ + -ipadx 6 -ipady 6 + $T style layout $S elemBmp -pady {0 6} -expand we + $T style layout $S elemSelTxt -union elemTxt -ipadx 2 + $T style layout $S elemTxt -expand we - # Set default item style - $T column configure C0 -itemstyle $S + # Set default item style + $T column configure C0 -itemstyle $S - # - # Create items and assign styles - # + # + # Create items and assign styles + # - set bitmapNames [list error gray75 gray50 gray25 gray12 hourglass info \ - questhead question warning] + set bitmapNames [list error gray75 gray50 gray25 gray12 hourglass info \ + questhead question warning] - foreach name $bitmapNames { - set I [$T item create] + foreach name $bitmapNames { + set I [$T item create] # $T item style set $I 0 $S - $T item text $I C0 $name - $T item element configure $I C0 elemBmp -bitmap $name - $T item lastchild root $I - } - - foreach name $bitmapNames { - set I [$T item create] - $T item style set $I C0 $S - $T item text $I C0 $name + $T item text $I C0 $name + $T item element configure $I C0 elemBmp -bitmap $name + $T item lastchild root $I + } + + foreach name $bitmapNames { + set I [$T item create] + $T item style set $I C0 $S + $T item text $I C0 $name if 1 { - $T item element configure $I C0 elemBmp -bitmap $name \ - -foreground [list brown {}] \ - -background {"" {}} + $T item element configure $I C0 elemBmp -bitmap $name \ + -foreground [list brown {}] \ + -background {"" {}} } else { - $T item element configure $I C0 elemBmp -bitmap $name \ - -foreground [list $::SystemHighlight {selected focus} brown {}] \ - -background {"" {}} + $T item element configure $I C0 elemBmp -bitmap $name \ + -foreground [list $::SystemHighlight {selected focus} brown {}] \ + -background {"" {}} } - $T item lastchild root $I - } + $T item lastchild root $I + } - return + return } diff --git a/demos/explorer.tcl b/demos/explorer.tcl index 8c0cd1f..45de1c8 100644 --- a/demos/explorer.tcl +++ b/demos/explorer.tcl @@ -1,72 +1,72 @@ -# RCS: @(#) $Id: explorer.tcl,v 1.23 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: explorer.tcl,v 1.24 2006/11/30 02:41:38 treectrl Exp $ set Dir [file dirname [file dirname [info script]]] set shellicon 0 # Might work on other windows versions, but only tested on XP if {$tcl_platform(os) eq "Windows NT" && $tcl_platform(osVersion) == 5.1} { - catch { - lappend auto_path $treectrl_library - package require shellicon $VERSION - set shellicon 1 - } + catch { + lappend auto_path $treectrl_library + package require shellicon $VERSION + set shellicon 1 + } } proc DemoExplorerAux {scriptDir scriptFile} { - global Explorer - global Dir + global Explorer + global Dir - set T [DemoList] + set T [DemoList] - set clicks [clock clicks] - set globDirs [glob -nocomplain -types d -dir $Dir *] - set clickGlobDirs [expr {[clock clicks] - $clicks}] + set clicks [clock clicks] + set globDirs [glob -nocomplain -types d -dir $Dir *] + set clickGlobDirs [expr {[clock clicks] - $clicks}] - set clicks [clock clicks] - set list [lsort -dictionary $globDirs] - set clickSortDirs [expr {[clock clicks] - $clicks}] + set clicks [clock clicks] + set list [lsort -dictionary $globDirs] + set clickSortDirs [expr {[clock clicks] - $clicks}] - if {[file dirname $Dir] ne $Dir} { - lappend globDirs ".." - set list [concat ".." $list] - } + if {[file dirname $Dir] ne $Dir} { + lappend globDirs ".." + set list [concat ".." $list] + } - set clicks [clock clicks] - foreach file $list $scriptDir - set clickAddDirs [expr {[clock clicks] - $clicks}] + set clicks [clock clicks] + foreach file $list $scriptDir + set clickAddDirs [expr {[clock clicks] - $clicks}] - $T item tag add "root children" directory + $T item tag add "root children" directory - set clicks [clock clicks] - set globFiles [glob -nocomplain -types f -dir $Dir *] - set clickGlobFiles [expr {[clock clicks] - $clicks}] + set clicks [clock clicks] + set globFiles [glob -nocomplain -types f -dir $Dir *] + set clickGlobFiles [expr {[clock clicks] - $clicks}] - set clicks [clock clicks] - set list [lsort -dictionary $globFiles] - set clickSortFiles [expr {[clock clicks] - $clicks}] + set clicks [clock clicks] + set list [lsort -dictionary $globFiles] + set clickSortFiles [expr {[clock clicks] - $clicks}] - set clicks [clock clicks] - foreach file $list $scriptFile - set clickAddFiles [expr {[clock clicks] - $clicks}] + set clicks [clock clicks] + foreach file $list $scriptFile + set clickAddFiles [expr {[clock clicks] - $clicks}] - set gd [ClicksToSeconds $clickGlobDirs] - set sd [ClicksToSeconds $clickSortDirs] - set ad [ClicksToSeconds $clickAddDirs] - set gf [ClicksToSeconds $clickGlobFiles] - set sf [ClicksToSeconds $clickSortFiles] - set af [ClicksToSeconds $clickAddFiles] - puts "dirs([llength $globDirs]) glob/sort/add $gd/$sd/$ad files([llength $globFiles]) glob/sort/add $gf/$sf/$af" + set gd [ClicksToSeconds $clickGlobDirs] + set sd [ClicksToSeconds $clickSortDirs] + set ad [ClicksToSeconds $clickAddDirs] + set gf [ClicksToSeconds $clickGlobFiles] + set sf [ClicksToSeconds $clickSortFiles] + set af [ClicksToSeconds $clickAddFiles] + puts "dirs([llength $globDirs]) glob/sort/add $gd/$sd/$ad files([llength $globFiles]) glob/sort/add $gf/$sf/$af" - set ::TreeCtrl::Priv(DirCnt,$T) [llength $globDirs] + set ::TreeCtrl::Priv(DirCnt,$T) [llength $globDirs] - # Double-clicking a directory displays its contents. - set Explorer(scriptDir) $scriptDir - set Explorer(scriptFile) $scriptFile - bind DemoExplorer { - ExplorerDoubleButton1 %W %x %y - } + # Double-clicking a directory displays its contents. + set Explorer(scriptDir) $scriptDir + set Explorer(scriptFile) $scriptFile + bind DemoExplorer { + ExplorerDoubleButton1 %W %x %y + } - return + return } # @@ -74,535 +74,535 @@ proc DemoExplorerAux {scriptDir scriptFile} { # proc DemoExplorerDetails {} { - set T [DemoList] - - set height [font metrics [$T cget -font] -linespace] - if {$height < 18} { - set height 18 - } - - # - # Configure the treectrl widget - # - - $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ - -selectmode extended -xscrollincrement 20 \ - -scrollmargin 16 -xscrolldelay "500 50" -yscrolldelay "500 50" - - InitPics small-* - - # - # Create columns - # - - $T column create -text Name -tags name -width 200 \ - -arrow up -itembackground #F7F7F7 - $T column create -text Size -tags size -justify right -width 60 \ - -arrowside left -arrowgravity right - $T column create -text Type -tags type -width 120 - $T column create -text Modified -tags modified -width 120 - - # Demonstration of per-state column options and configure "all" - $T column configure all -background {gray90 active gray70 normal gray50 pressed} - - # - # Create elements - # - + set T [DemoList] + + set height [font metrics [$T cget -font] -linespace] + if {$height < 18} { + set height 18 + } + + # + # Configure the treectrl widget + # + + $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ + -selectmode extended -xscrollincrement 20 \ + -scrollmargin 16 -xscrolldelay "500 50" -yscrolldelay "500 50" + + InitPics small-* + + # + # Create columns + # + + $T column create -text Name -tags name -width 200 \ + -arrow up -itembackground #F7F7F7 + $T column create -text Size -tags size -justify right -width 60 \ + -arrowside left -arrowgravity right + $T column create -text Type -tags type -width 120 + $T column create -text Modified -tags modified -width 120 + + # Demonstration of per-state column options and configure "all" + $T column configure all -background {gray90 active gray70 normal gray50 pressed} + + # + # Create elements + # + + if {$::shellicon} { + $T element create elemImg shellicon -size small + } else { + $T element create elemImg image -image {small-folderSel {selected} small-folder {}} + } + $T element create txtName text -fill [list $::SystemHighlightText {selected focus}] \ + -lines 1 + $T element create txtType text -lines 1 + $T element create txtSize text -datatype integer -format "%dKB" -lines 1 + $T element create txtDate text -datatype time -format "%d/%m/%y %I:%M %p" -lines 1 + $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -showfocus yes + + # + # Create styles using the elements + # + + # column 0: image + text + set S [$T style create styName -orient horizontal] + $T style elements $S {elemRectSel elemImg txtName} + $T style layout $S elemImg -padx {2 0} -expand ns + $T style layout $S txtName -squeeze x -expand ns + $T style layout $S elemRectSel -union [list txtName] -ipadx 2 -iexpand ns + + # column 1: text + set S [$T style create stySize] + $T style elements $S txtSize + $T style layout $S txtSize -padx 6 -squeeze x -expand ns + + # column 2: text + set S [$T style create styType] + $T style elements $S txtType + $T style layout $S txtType -padx 6 -squeeze x -expand ns + + # column 3: text + set S [$T style create styDate] + $T style elements $S txtDate + $T style layout $S txtDate -padx 6 -squeeze x -expand ns + + # List of lists: {column style element ...} specifying text elements + # the user can edit + TreeCtrl::SetEditable $T { + {name styName txtName} + } + + # List of lists: {column style element ...} specifying elements + # the user can click on or select with the selection rectangle + TreeCtrl::SetSensitive $T { + {name styName elemImg txtName} + } + + # List of lists: {column style element ...} specifying elements + # added to the drag image when dragging selected items + TreeCtrl::SetDragImage $T { + {name styName elemImg txtName} + } + + # During editing, hide the text and selection-rectangle elements. + $T notify bind $T { + %T item element configure %I %C txtName -draw no + elemRectSel -draw no + } + $T notify bind $T { + %T item element configure %I %C %E -text %t + } + $T notify bind $T { + %T item element configure %I %C txtName -draw yes + elemRectSel -draw yes + } + + # + # Create items and assign styles + # + + set scriptDir { + set item [$T item create -open no] + $T item style set $item name styName type styType modified styDate + $T item element configure $item \ + name txtName -text [file tail $file] , \ + type txtType -text "Folder" , \ + modified txtDate -data [file mtime $file] if {$::shellicon} { - $T element create elemImg shellicon -size small + # The shellicon extension fails randomly (by putting GDB into the + # background!?) if the filename is not valid. MSDN says "relative + # paths are valid" but perhaps that is misinformation. + if {$file eq ".."} { set file [file dirname $::Dir] } + $T item element configure $item \ + name elemImg -path $file + } + $T item lastchild root $item + } + + set scriptFile { + set item [$T item create -open no] + $T item style set $item name styName size stySize type styType modified styDate + switch [file extension $file] { + .dll { set img small-dll } + .exe { set img small-exe } + .txt { set img small-txt } + default { set img small-file } + } + set type [string toupper [file extension $file]] + if {$type ne ""} { + set type "[string range $type 1 end] " + } + append type "File" + if {$::shellicon} { + $T item element configure $item \ + name elemImg -path $file + txtName -text [file tail $file] , \ + size txtSize -data [expr {[file size $file] / 1024 + 1}] , \ + type txtType -text $type , \ + modified txtDate -data [file mtime $file] } else { - $T element create elemImg image -image {small-folderSel {selected} small-folder {}} - } - $T element create txtName text -fill [list $::SystemHighlightText {selected focus}] \ - -lines 1 - $T element create txtType text -lines 1 - $T element create txtSize text -datatype integer -format "%dKB" -lines 1 - $T element create txtDate text -datatype time -format "%d/%m/%y %I:%M %p" -lines 1 - $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -showfocus yes - - # - # Create styles using the elements - # - - # column 0: image + text - set S [$T style create styName -orient horizontal] - $T style elements $S {elemRectSel elemImg txtName} - $T style layout $S elemImg -padx {2 0} -expand ns - $T style layout $S txtName -squeeze x -expand ns - $T style layout $S elemRectSel -union [list txtName] -ipadx 2 -iexpand ns - - # column 1: text - set S [$T style create stySize] - $T style elements $S txtSize - $T style layout $S txtSize -padx 6 -squeeze x -expand ns - - # column 2: text - set S [$T style create styType] - $T style elements $S txtType - $T style layout $S txtType -padx 6 -squeeze x -expand ns - - # column 3: text - set S [$T style create styDate] - $T style elements $S txtDate - $T style layout $S txtDate -padx 6 -squeeze x -expand ns - - # List of lists: {column style element ...} specifying text elements - # the user can edit - TreeCtrl::SetEditable $T { - {name styName txtName} + $T item element configure $item \ + name elemImg -image [list ${img}Sel {selected} $img {}] + txtName -text [file tail $file] , \ + size txtSize -data [expr {[file size $file] / 1024 + 1}] , \ + type txtType -text $type , \ + modified txtDate -data [file mtime $file] } + $T item lastchild root $item + } - # List of lists: {column style element ...} specifying elements - # the user can click on or select with the selection rectangle - TreeCtrl::SetSensitive $T { - {name styName elemImg txtName} - } + DemoExplorerAux $scriptDir $scriptFile - # List of lists: {column style element ...} specifying elements - # added to the drag image when dragging selected items - TreeCtrl::SetDragImage $T { - {name styName elemImg txtName} - } + set ::SortColumn name + $T notify bind $T { ExplorerHeaderInvoke %T %C } - # During editing, hide the text and selection-rectangle elements. - $T notify bind $T { - %T item element configure %I %C txtName -draw no + elemRectSel -draw no - } - $T notify bind $T { - %T item element configure %I %C %E -text %t - } - $T notify bind $T { - %T item element configure %I %C txtName -draw yes + elemRectSel -draw yes - } - - # - # Create items and assign styles - # - - set scriptDir { - set item [$T item create -open no] - $T item style set $item name styName type styType modified styDate - $T item element configure $item \ - name txtName -text [file tail $file] , \ - type txtType -text "Folder" , \ - modified txtDate -data [file mtime $file] - if {$::shellicon} { - # The shellicon extension fails randomly (by putting GDB into the - # background!?) if the filename is not valid. MSDN says "relative - # paths are valid" but perhaps that is misinformation. - if {$file eq ".."} { set file [file dirname $::Dir] } - $T item element configure $item \ - name elemImg -path $file - } - $T item lastchild root $item - } - - set scriptFile { - set item [$T item create -open no] - $T item style set $item name styName size stySize type styType modified styDate - switch [file extension $file] { - .dll { set img small-dll } - .exe { set img small-exe } - .txt { set img small-txt } - default { set img small-file } - } - set type [string toupper [file extension $file]] - if {$type ne ""} { - set type "[string range $type 1 end] " - } - append type "File" - if {$::shellicon} { - $T item element configure $item \ - name elemImg -path $file + txtName -text [file tail $file] , \ - size txtSize -data [expr {[file size $file] / 1024 + 1}] , \ - type txtType -text $type , \ - modified txtDate -data [file mtime $file] - } else { - $T item element configure $item \ - name elemImg -image [list ${img}Sel {selected} $img {}] + txtName -text [file tail $file] , \ - size txtSize -data [expr {[file size $file] / 1024 + 1}] , \ - type txtType -text $type , \ - modified txtDate -data [file mtime $file] - } - $T item lastchild root $item - } + bindtags $T [list $T DemoExplorer TreeCtrlFileList TreeCtrl [winfo toplevel $T] all] - DemoExplorerAux $scriptDir $scriptFile - - set ::SortColumn name - $T notify bind $T { ExplorerHeaderInvoke %T %C } - - bindtags $T [list $T DemoExplorer TreeCtrlFileList TreeCtrl [winfo toplevel $T] all] - - return + return } proc ExplorerHeaderInvoke {T C} { - global SortColumn - if {[$T column compare $C == $SortColumn]} { - if {[$T column cget $SortColumn -arrow] eq "down"} { - set order -increasing - set arrow up - } else { - set order -decreasing - set arrow down - } + global SortColumn + if {[$T column compare $C == $SortColumn]} { + if {[$T column cget $SortColumn -arrow] eq "down"} { + set order -increasing + set arrow up } else { - if {[$T column cget $SortColumn -arrow] eq "down"} { - set order -decreasing - set arrow down - } else { - set order -increasing - set arrow up - } - $T column configure $SortColumn -arrow none -itembackground {} - set SortColumn $C - } - $T column configure $C -arrow $arrow -itembackground #F7F7F7 - set dirCount $::TreeCtrl::Priv(DirCnt,$T) - set fileCount [expr {[$T item count] - 1 - $dirCount}] - set lastDir [expr {$dirCount - 1}] - switch [$T column cget $C -tags] { - name { - if {$dirCount} { - $T item sort root $order -last "root child $lastDir" -column $C -dictionary - } - if {$fileCount} { - $T item sort root $order -first "root child $dirCount" -column $C -dictionary - } - } - size { - if {$fileCount} { - $T item sort root $order -first "root child $dirCount" -column $C -integer -column name -dictionary - } - } - type { - if {$fileCount} { - $T item sort root $order -first "root child $dirCount" -column $C -dictionary -column name -dictionary - } - } - modified { - if {$dirCount} { - $T item sort root $order -last "root child $lastDir" -column $C -integer -column name -dictionary - } - if {$fileCount} { - $T item sort root $order -first "root child $dirCount" -column $C -integer -column name -dictionary - } - } + set order -decreasing + set arrow down } - return + } else { + if {[$T column cget $SortColumn -arrow] eq "down"} { + set order -decreasing + set arrow down + } else { + set order -increasing + set arrow up + } + $T column configure $SortColumn -arrow none -itembackground {} + set SortColumn $C + } + $T column configure $C -arrow $arrow -itembackground #F7F7F7 + set dirCount $::TreeCtrl::Priv(DirCnt,$T) + set fileCount [expr {[$T item count] - 1 - $dirCount}] + set lastDir [expr {$dirCount - 1}] + switch [$T column cget $C -tags] { + name { + if {$dirCount} { + $T item sort root $order -last "root child $lastDir" -column $C -dictionary + } + if {$fileCount} { + $T item sort root $order -first "root child $dirCount" -column $C -dictionary + } + } + size { + if {$fileCount} { + $T item sort root $order -first "root child $dirCount" -column $C -integer -column name -dictionary + } + } + type { + if {$fileCount} { + $T item sort root $order -first "root child $dirCount" -column $C -dictionary -column name -dictionary + } + } + modified { + if {$dirCount} { + $T item sort root $order -last "root child $lastDir" -column $C -integer -column name -dictionary + } + if {$fileCount} { + $T item sort root $order -first "root child $dirCount" -column $C -integer -column name -dictionary + } + } + } + return } proc DemoExplorerLargeIcons {} { - set T [DemoList] - - # Item height is 32 for icon, 4 padding, 3 lines of text - set itemHeight [expr {32 + 4 + [font metrics [$T cget -font] -linespace] * 3}] - - # - # Configure the treectrl widget - # - - $T configure -showroot no -showbuttons no -showlines no \ - -selectmode extended -wrap window -orient horizontal \ - -itemheight $itemHeight -itemwidth 75 -showheader no \ - -scrollmargin 16 -xscrolldelay "500 50" -yscrolldelay "500 50" - - InitPics big-* - - # - # Create columns - # - - $T column create -tags C0 - - # - # Create elements - # - + set T [DemoList] + + # Item height is 32 for icon, 4 padding, 3 lines of text + set itemHeight [expr {32 + 4 + [font metrics [$T cget -font] -linespace] * 3}] + + # + # Configure the treectrl widget + # + + $T configure -showroot no -showbuttons no -showlines no \ + -selectmode extended -wrap window -orient horizontal \ + -itemheight $itemHeight -itemwidth 75 -showheader no \ + -scrollmargin 16 -xscrolldelay "500 50" -yscrolldelay "500 50" + + InitPics big-* + + # + # Create columns + # + + $T column create -tags C0 + + # + # Create elements + # + + if {$::shellicon} { + $T element create elemImg shellicon -size large + } else { + $T element create elemImg image -image {big-folderSel {selected} big-folder {}} + } + $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] \ + -justify center -lines 1 -width 71 -wrap word + $T element create elemSel rect -fill [list $::SystemHighlight {selected focus} gray {selected}] -showfocus yes + + # + # Create styles using the elements + # + + # image + text + set S [$T style create STYLE -orient vertical] + $T style elements $S {elemSel elemImg elemTxt} + $T style layout $S elemImg -expand we + $T style layout $S elemTxt -pady {4 0} -squeeze x -expand we + $T style layout $S elemSel -union [list elemTxt] -ipadx 2 + + # List of lists: {column style element ...} specifying text elements + # the user can edit + TreeCtrl::SetEditable $T { + {C0 STYLE elemTxt} + } + + # List of lists: {column style element ...} specifying elements + # the user can click on or select with the selection rectangle + TreeCtrl::SetSensitive $T { + {C0 STYLE elemImg elemTxt} + } + + # List of lists: {column style element ...} specifying elements + # added to the drag image when dragging selected items + TreeCtrl::SetDragImage $T { + {C0 STYLE elemImg elemTxt} + } + + # During editing, hide the text and selection-rectangle elements. + $T state define edit + $T element configure elemTxt -draw {no edit} + $T element configure elemSel -draw {no edit} + $T notify bind $T { + %T item state set %I ~edit + } + $T notify bind $T { + %T item element configure %I %C %E -text %t + } + $T notify bind $T { + %T item state set %I ~edit + } + + # + # Create items and assign styles + # + + set scriptDir { + set item [$T item create -open no] + $T item style set $item C0 STYLE + $T item text $item C0 [file tail $file] if {$::shellicon} { - $T element create elemImg shellicon -size large + # The shellicon extension fails randomly (by putting GDB into the + # background!?) if the filename is not valid. MSDN says "relative + # paths are valid" but perhaps that is misinformation. + if {$file eq ".."} { set file [file dirname $::Dir] } + $T item element configure $item C0 \ + elemImg -path $file + } + $T item lastchild root $item + } + + set scriptFile { + set item [$T item create -open no] + $T item style set $item C0 STYLE + switch [file extension $file] { + .dll { set img big-dll } + .exe { set img big-exe } + .txt { set img big-txt } + default { set img big-file } + } + set type [string toupper [file extension $file]] + if {$type ne ""} { + set type "[string range $type 1 end] " + } + append type "File" + if {$::shellicon} { + $T item element configure $item C0 \ + elemImg -path $file + \ + elemTxt -text [file tail $file] } else { - $T element create elemImg image -image {big-folderSel {selected} big-folder {}} - } - $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] \ - -justify center -lines 1 -width 71 -wrap word - $T element create elemSel rect -fill [list $::SystemHighlight {selected focus} gray {selected}] -showfocus yes - - # - # Create styles using the elements - # - - # image + text - set S [$T style create STYLE -orient vertical] - $T style elements $S {elemSel elemImg elemTxt} - $T style layout $S elemImg -expand we - $T style layout $S elemTxt -pady {4 0} -squeeze x -expand we - $T style layout $S elemSel -union [list elemTxt] -ipadx 2 - - # List of lists: {column style element ...} specifying text elements - # the user can edit - TreeCtrl::SetEditable $T { - {C0 STYLE elemTxt} + $T item element configure $item C0 \ + elemImg -image [list ${img}Sel {selected} $img {}] + \ + elemTxt -text [file tail $file] } + $T item lastchild root $item + } - # List of lists: {column style element ...} specifying elements - # the user can click on or select with the selection rectangle - TreeCtrl::SetSensitive $T { - {C0 STYLE elemImg elemTxt} - } - - # List of lists: {column style element ...} specifying elements - # added to the drag image when dragging selected items - TreeCtrl::SetDragImage $T { - {C0 STYLE elemImg elemTxt} - } + DemoExplorerAux $scriptDir $scriptFile - # During editing, hide the text and selection-rectangle elements. - $T state define edit - $T element configure elemTxt -draw {no edit} - $T element configure elemSel -draw {no edit} - $T notify bind $T { - %T item state set %I ~edit - } - $T notify bind $T { - %T item element configure %I %C %E -text %t - } - $T notify bind $T { - %T item state set %I ~edit - } + $T activate [$T item id "root firstchild"] - # - # Create items and assign styles - # - - set scriptDir { - set item [$T item create -open no] - $T item style set $item C0 STYLE - $T item text $item C0 [file tail $file] - if {$::shellicon} { - # The shellicon extension fails randomly (by putting GDB into the - # background!?) if the filename is not valid. MSDN says "relative - # paths are valid" but perhaps that is misinformation. - if {$file eq ".."} { set file [file dirname $::Dir] } - $T item element configure $item C0 \ - elemImg -path $file - } - $T item lastchild root $item + $T notify bind $T { + if {[%T item compare %p != root]} { + %T item element configure %p C0 elemTxt -lines {} } - - set scriptFile { - set item [$T item create -open no] - $T item style set $item C0 STYLE - switch [file extension $file] { - .dll { set img big-dll } - .exe { set img big-exe } - .txt { set img big-txt } - default { set img big-file } - } - set type [string toupper [file extension $file]] - if {$type ne ""} { - set type "[string range $type 1 end] " - } - append type "File" - if {$::shellicon} { - $T item element configure $item C0 \ - elemImg -path $file + \ - elemTxt -text [file tail $file] - } else { - $T item element configure $item C0 \ - elemImg -image [list ${img}Sel {selected} $img {}] + \ - elemTxt -text [file tail $file] - } - $T item lastchild root $item + if {[%T item compare %c != root]} { + %T item element configure %c C0 elemTxt -lines 3 } + } + $T item element configure active C0 elemTxt -lines 3 - DemoExplorerAux $scriptDir $scriptFile - - $T activate [$T item id "root firstchild"] + bindtags $T [list $T DemoExplorer TreeCtrlFileList TreeCtrl [winfo toplevel $T] all] - $T notify bind $T { - if {[%T item compare %p != root]} { - %T item element configure %p C0 elemTxt -lines {} - } - if {[%T item compare %c != root]} { - %T item element configure %c C0 elemTxt -lines 3 - } - } - $T item element configure active C0 elemTxt -lines 3 - - bindtags $T [list $T DemoExplorer TreeCtrlFileList TreeCtrl [winfo toplevel $T] all] - - return + return } # Tree is horizontal, wrapping occurs at right edge of window, each item # is as wide as the smallest needed multiple of 110 pixels proc DemoExplorerSmallIcons {} { - set T [DemoList] - DemoExplorerList - $T configure -orient horizontal \ - -itemwidthmultiple 110 -itemwidthequal no - return + set T [DemoList] + DemoExplorerList + $T configure -orient horizontal \ + -itemwidthmultiple 110 -itemwidthequal no + return } # Tree is vertical, wrapping occurs at bottom of window, each range has the # same width (as wide as the longest item), xscrollincrement is by range proc DemoExplorerList {} { - set T [DemoList] - - set height [font metrics [$T cget -font] -linespace] - if {$height < 18} { - set height 18 - } - - # - # Configure the treectrl widget - # - - $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ - -selectmode extended -wrap window -showheader no \ - -scrollmargin 16 -xscrolldelay "500 50" -yscrolldelay "500 50" \ - -itemwidthequal yes - - InitPics small-* - - # - # Create columns - # - - $T column create -tags C0 - - # - # Create elements - # - + set T [DemoList] + + set height [font metrics [$T cget -font] -linespace] + if {$height < 18} { + set height 18 + } + + # + # Configure the treectrl widget + # + + $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ + -selectmode extended -wrap window -showheader no \ + -scrollmargin 16 -xscrolldelay "500 50" -yscrolldelay "500 50" \ + -itemwidthequal yes + + InitPics small-* + + # + # Create columns + # + + $T column create -tags C0 + + # + # Create elements + # + + if {$::shellicon} { + $T element create elemImg shellicon -size small + } else { + $T element create elemImg image -image {small-folderSel {selected} small-folder {}} + } + $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] \ + -lines 1 + $T element create elemSel rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -showfocus yes + + # + # Create styles using the elements + # + + # image + text + set S [$T style create STYLE] + $T style elements $S {elemSel elemImg elemTxt} + $T style layout $S elemImg -expand ns + $T style layout $S elemTxt -squeeze x -expand ns -padx {2 0} + $T style layout $S elemSel -union [list elemTxt] -iexpand ns -ipadx 2 + + # List of lists: {column style element ...} specifying text elements + # the user can edit + TreeCtrl::SetEditable $T { + {C0 STYLE elemTxt} + } + + # List of lists: {column style element ...} specifying elements + # the user can click on or select with the selection rectangle + TreeCtrl::SetSensitive $T { + {C0 STYLE elemImg elemTxt} + } + + # List of lists: {column style element ...} specifying elements + # added to the drag image when dragging selected items + TreeCtrl::SetDragImage $T { + {C0 STYLE elemImg elemTxt} + } + + # During editing, hide the text and selection-rectangle elements. + $T notify bind $T { + %T item element configure %I %C elemSel -draw no + elemTxt -draw no + } + $T notify bind $T { + %T item element configure %I %C %E -text %t + } + $T notify bind $T { + %T item element configure %I %C elemSel -draw yes + elemTxt -draw yes + } + + # + # Create items and assign styles + # + + set scriptDir { + set item [$T item create -open no] + $T item style set $item C0 STYLE + $T item text $item C0 [file tail $file] if {$::shellicon} { - $T element create elemImg shellicon -size small + # The shellicon extension fails randomly (by putting GDB into the + # background!?) if the filename is not valid. MSDN says "relative + # paths are valid" but perhaps that is misinformation. + if {$file eq ".."} { set file [file dirname $::Dir] } + $T item element configure $item C0 \ + elemImg -path $file + } + $T item lastchild root $item + } + + set scriptFile { + set item [$T item create -open no] + $T item style set $item C0 STYLE + switch [file extension $file] { + .dll { set img small-dll } + .exe { set img small-exe } + .txt { set img small-txt } + default { set img small-file } + } + set type [string toupper [file extension $file]] + if {$type ne ""} { + set type "[string range $type 1 end] " + } + append type "File" + if {$::shellicon} { + $T item element configure $item C0 \ + elemImg -path $file + \ + elemTxt -text [file tail $file] } else { - $T element create elemImg image -image {small-folderSel {selected} small-folder {}} - } - $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] \ - -lines 1 - $T element create elemSel rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -showfocus yes - - # - # Create styles using the elements - # - - # image + text - set S [$T style create STYLE] - $T style elements $S {elemSel elemImg elemTxt} - $T style layout $S elemImg -expand ns - $T style layout $S elemTxt -squeeze x -expand ns -padx {2 0} - $T style layout $S elemSel -union [list elemTxt] -iexpand ns -ipadx 2 - - # List of lists: {column style element ...} specifying text elements - # the user can edit - TreeCtrl::SetEditable $T { - {C0 STYLE elemTxt} - } - - # List of lists: {column style element ...} specifying elements - # the user can click on or select with the selection rectangle - TreeCtrl::SetSensitive $T { - {C0 STYLE elemImg elemTxt} - } - - # List of lists: {column style element ...} specifying elements - # added to the drag image when dragging selected items - TreeCtrl::SetDragImage $T { - {C0 STYLE elemImg elemTxt} + $T item element configure $item C0 \ + elemImg -image [list ${img}Sel {selected} $img {}] + \ + elemTxt -text [file tail $file] } + $T item lastchild root $item + } - # During editing, hide the text and selection-rectangle elements. - $T notify bind $T { - %T item element configure %I %C elemSel -draw no + elemTxt -draw no - } - $T notify bind $T { - %T item element configure %I %C %E -text %t - } - $T notify bind $T { - %T item element configure %I %C elemSel -draw yes + elemTxt -draw yes - } + DemoExplorerAux $scriptDir $scriptFile - # - # Create items and assign styles - # - - set scriptDir { - set item [$T item create -open no] - $T item style set $item C0 STYLE - $T item text $item C0 [file tail $file] - if {$::shellicon} { - # The shellicon extension fails randomly (by putting GDB into the - # background!?) if the filename is not valid. MSDN says "relative - # paths are valid" but perhaps that is misinformation. - if {$file eq ".."} { set file [file dirname $::Dir] } - $T item element configure $item C0 \ - elemImg -path $file - } - $T item lastchild root $item - } + $T activate [$T item firstchild root] - set scriptFile { - set item [$T item create -open no] - $T item style set $item C0 STYLE - switch [file extension $file] { - .dll { set img small-dll } - .exe { set img small-exe } - .txt { set img small-txt } - default { set img small-file } - } - set type [string toupper [file extension $file]] - if {$type ne ""} { - set type "[string range $type 1 end] " - } - append type "File" - if {$::shellicon} { - $T item element configure $item C0 \ - elemImg -path $file + \ - elemTxt -text [file tail $file] - } else { - $T item element configure $item C0 \ - elemImg -image [list ${img}Sel {selected} $img {}] + \ - elemTxt -text [file tail $file] - } - $T item lastchild root $item - } + bindtags $T [list $T DemoExplorer TreeCtrlFileList TreeCtrl [winfo toplevel $T] all] - DemoExplorerAux $scriptDir $scriptFile - - $T activate [$T item firstchild root] - - bindtags $T [list $T DemoExplorer TreeCtrlFileList TreeCtrl [winfo toplevel $T] all] - - return + return } proc ExplorerDoubleButton1 {w x y} { - global Explorer - global Dir - set id [$w identify $x $y] - if {[TreeCtrl::IsSensitive $w $x $y]} { - set item [lindex $id 1] - set column [lindex $id 3] - if {[$w item tag expr $item directory]} { - set name [$w item text $item $column] - if {$name eq ".."} { - set Dir [file dirname $Dir] - } else { - set Dir [file join $Dir $name] - } - $w item delete all - DemoExplorerAux $Explorer(scriptDir) $Explorer(scriptFile) - $w activate "root firstchild" - $w xview moveto 0.0 - $w yview moveto 0.0 - } - } - return + global Explorer + global Dir + set id [$w identify $x $y] + if {[TreeCtrl::IsSensitive $w $x $y]} { + set item [lindex $id 1] + set column [lindex $id 3] + if {[$w item tag expr $item directory]} { + set name [$w item text $item $column] + if {$name eq ".."} { + set Dir [file dirname $Dir] + } else { + set Dir [file join $Dir $name] + } + $w item delete all + DemoExplorerAux $Explorer(scriptDir) $Explorer(scriptFile) + $w activate "root firstchild" + $w xview moveto 0.0 + $w yview moveto 0.0 + } + } + return } diff --git a/demos/firefox.tcl b/demos/firefox.tcl index a9f4a33..db654e9 100644 --- a/demos/firefox.tcl +++ b/demos/firefox.tcl @@ -1,479 +1,479 @@ -# RCS: @(#) $Id: firefox.tcl,v 1.17 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: firefox.tcl,v 1.18 2006/11/30 02:41:38 treectrl Exp $ proc DemoFirefoxPrivacy {} { - global FirefoxPrivacy + global FirefoxPrivacy - set T [DemoList] + set T [DemoList] - # - # Configure the treectrl widget - # + # + # Configure the treectrl widget + # - $T configure -showroot no -showbuttons yes -showlines no \ - -selectmode extended -xscrollincrement 20 -showheader yes + $T configure -showroot no -showbuttons yes -showlines no \ + -selectmode extended -xscrollincrement 20 -showheader yes if {$::clip} { - $T configure -xscrollincrement 4 -yscrollincrement 4 + $T configure -xscrollincrement 4 -yscrollincrement 4 } else { - # Hide the borders because child windows appear on top of them - $T configure -borderwidth 0 -highlightthickness 0 + # Hide the borders because child windows appear on top of them + $T configure -borderwidth 0 -highlightthickness 0 } - # - # Create columns - # - - # Create 2 new images for the button sort arrow - if {[lsearch -exact [image names] arrow-up] == -1} { - - set color #ACA899 ; # WinXP arrow color - - set img arrow-down - image create photo $img - $img put [list [string repeat "$color " 9]] -to 0 0 - $img put [list [string repeat "$color " 7]] -to 1 1 - $img put [list [string repeat "$color " 5]] -to 2 2 - $img put [list [string repeat "$color " 3]] -to 3 3 - $img put [list [string repeat "$color " 1]] -to 4 4 - - set img arrow-up - image create photo $img - $img put [list [string repeat "$color " 1]] -to 4 0 - $img put [list [string repeat "$color " 3]] -to 3 1 - $img put [list [string repeat "$color " 5]] -to 2 2 - $img put [list [string repeat "$color " 7]] -to 1 3 - $img put [list [string repeat "$color " 9]] -to 0 4 - } - - $T column create -expand yes -arrowimage {arrow-down !up arrow-up {}} \ - -arrow up -arrowpadx {10 2} -textlines 0 -tags C0 \ - -text "This is a multi-line column title\nwith an image for the arrow" - - $T configure -treecolumn C0 - - # This binding toggles the sort arrow - $T notify bind $T { - if {[%T column cget %C -arrow] eq "up"} { - %T column configure %C -arrow down - } else { - %T column configure %C -arrow up - } + # + # Create columns + # + + # Create 2 new images for the button sort arrow + if {[lsearch -exact [image names] arrow-up] == -1} { + + set color #ACA899 ; # WinXP arrow color + + set img arrow-down + image create photo $img + $img put [list [string repeat "$color " 9]] -to 0 0 + $img put [list [string repeat "$color " 7]] -to 1 1 + $img put [list [string repeat "$color " 5]] -to 2 2 + $img put [list [string repeat "$color " 3]] -to 3 3 + $img put [list [string repeat "$color " 1]] -to 4 4 + + set img arrow-up + image create photo $img + $img put [list [string repeat "$color " 1]] -to 4 0 + $img put [list [string repeat "$color " 3]] -to 3 1 + $img put [list [string repeat "$color " 5]] -to 2 2 + $img put [list [string repeat "$color " 7]] -to 1 3 + $img put [list [string repeat "$color " 9]] -to 0 4 + } + + $T column create -expand yes -arrowimage {arrow-down !up arrow-up {}} \ + -arrow up -arrowpadx {10 2} -textlines 0 -tags C0 \ + -text "This is a multi-line column title\nwith an image for the arrow" + + $T configure -treecolumn C0 + + # This binding toggles the sort arrow + $T notify bind $T { + if {[%T column cget %C -arrow] eq "up"} { + %T column configure %C -arrow down + } else { + %T column configure %C -arrow up } + } - # - # Create elements - # + # + # Create elements + # - $T element create eWindow window + $T element create eWindow window if {$::clip} { $T element configure eWindow -clip yes } - $T element create eText1 text -font [list "[$T cget -font] bold"] - $T element create eRectTop rect -outline black -fill #FFFFCC \ - -draw {yes open no {}} -outlinewidth 1 -open s - $T element create eRectBottom rect -outline black -fill #FFFFCC \ - -outlinewidth 1 -open n - - # Destroy the window when the element is deleted. Could also bind to the - # event. - $T element configure eWindow -destroy yes - - # - # Create styles using the elements - # - - set S [$T style create styCategory -orient horizontal] - $T style elements $S {eRectTop eText1 eWindow} - $T style layout $S eRectTop -detach yes -indent no -iexpand xy - # note: using -iexpand x so clicking in the text works better - $T style layout $S eText1 -expand ns -iexpand x -sticky w - $T style layout $S eWindow -expand ns -padx 10 -pady 6 - - set S [$T style create styFrame -orient horizontal] - $T style elements $S {eRectBottom eWindow} - $T style layout $S eRectBottom -detach yes -indent no -iexpand xy - $T style layout $S eWindow -iexpand x -squeeze x -padx {0 2} -pady {0 8} - - # - # Create items and assign styles - # - - foreach category { - "History" - "Saved Form Information" - "Saved Passwords" - "Download Manager History" - "Cookies" - "Cache"} { - set I [$T item create -button yes] - $T item style set $I C0 styCategory - $T item element configure $I C0 eText1 -text $category + $T element create eText1 text -font [list "[$T cget -font] bold"] + $T element create eRectTop rect -outline black -fill #FFFFCC \ + -draw {yes open no {}} -outlinewidth 1 -open s + $T element create eRectBottom rect -outline black -fill #FFFFCC \ + -outlinewidth 1 -open n + + # Destroy the window when the element is deleted. Could also bind to the + # event. + $T element configure eWindow -destroy yes + + # + # Create styles using the elements + # + + set S [$T style create styCategory -orient horizontal] + $T style elements $S {eRectTop eText1 eWindow} + $T style layout $S eRectTop -detach yes -indent no -iexpand xy + # note: using -iexpand x so clicking in the text works better + $T style layout $S eText1 -expand ns -iexpand x -sticky w + $T style layout $S eWindow -expand ns -padx 10 -pady 6 + + set S [$T style create styFrame -orient horizontal] + $T style elements $S {eRectBottom eWindow} + $T style layout $S eRectBottom -detach yes -indent no -iexpand xy + $T style layout $S eWindow -iexpand x -squeeze x -padx {0 2} -pady {0 8} + + # + # Create items and assign styles + # + + foreach category { + "History" + "Saved Form Information" + "Saved Passwords" + "Download Manager History" + "Cookies" + "Cache"} { + set I [$T item create -button yes] + $T item style set $I C0 styCategory + $T item element configure $I C0 eText1 -text $category if {$::clip} { - set wClip [frame $T.clip$I -background red] - set b [$::buttonCmd $wClip.b$I -text "Clear" -command "" -width 11] - $T item element configure $I C0 eWindow -window $wClip + set wClip [frame $T.clip$I -background red] + set b [$::buttonCmd $wClip.b$I -text "Clear" -command "" -width 11] + $T item element configure $I C0 eWindow -window $wClip } else { - set b [$::buttonCmd $T.b$I -text "Clear" -command "" -width 11] - $T item element configure $I C0 eWindow -window $b + set b [$::buttonCmd $T.b$I -text "Clear" -command "" -width 11] + $T item element configure $I C0 eWindow -window $b } - $T item lastchild root $I - } + $T item lastchild root $I + } - set bg #FFFFCC - set textBg $bg + set bg #FFFFCC + set textBg $bg - if {$::tile} { - ttk::style configure DemoCheckbutton -background $bg - ttk::style layout DemoCheckbutton [ttk::style layout TCheckbutton] - } + if {$::tile} { + ttk::style configure DemoCheckbutton -background $bg + ttk::style layout DemoCheckbutton [ttk::style layout TCheckbutton] + } - # History - set I [$T item create] - $T item style set $I C0 styFrame + # History + set I [$T item create] + $T item style set $I C0 styFrame if {$::clip} { - set wClip [frame $T.clip$I -background red] - set f [frame $wClip.f$I -borderwidth 0 -background $bg] + set wClip [frame $T.clip$I -background red] + set f [frame $wClip.f$I -borderwidth 0 -background $bg] } else { - set f [frame $T.f$I -borderwidth 0 -background $bg] + set f [frame $T.f$I -borderwidth 0 -background $bg] } - label $f.l1 -background $bg -text "Remember visited pages for the last" - $::entryCmd $f.e1 -width 6 - $f.e1 insert end 20 - label $f.l2 -background $bg -text "days" -background $bg - pack $f.l1 -side left - pack $f.e1 -side left -padx 8 - pack $f.l2 -side left + label $f.l1 -background $bg -text "Remember visited pages for the last" + $::entryCmd $f.e1 -width 6 + $f.e1 insert end 20 + label $f.l2 -background $bg -text "days" -background $bg + pack $f.l1 -side left + pack $f.e1 -side left -padx 8 + pack $f.l2 -side left if {$::clip} { - $T item element configure $I C0 eWindow -window $wClip + $T item element configure $I C0 eWindow -window $wClip } else { - $T item element configure $I C0 eWindow -window $f + $T item element configure $I C0 eWindow -window $f } - $T item lastchild "root child 0" $I + $T item lastchild "root child 0" $I - # Saved Form Information - set I [$T item create] - $T item style set $I C0 styFrame + # Saved Form Information + set I [$T item create] + $T item style set $I C0 styFrame if {$::clip} { - set wClip [frame $T.clip$I -background red] - set f [frame $wClip.f$I -borderwidth 0 -background $bg] + set wClip [frame $T.clip$I -background red] + set f [frame $wClip.f$I -borderwidth 0 -background $bg] } else { - set f [frame $T.f$I -borderwidth 0 -background $bg] + set f [frame $T.f$I -borderwidth 0 -background $bg] } - text $f.t1 -background $textBg -borderwidth 0 -highlightthickness 0 \ - -width 10 -height 1 -wrap word -cursor "" - $f.t1 insert end "Information entered in web page forms and the Search\ - Bar is saved to make filling out forms and searching faster." - bindtags $f.t1 TextWrapBindTag - if {$::tile} { - $::checkbuttonCmd $f.cb1 -text "Save information I enter in web page forms and the Search Bar" \ - -variable ::cbvar($f.cb1) -style DemoCheckbutton - } else { - checkbutton $f.cb1 -background $bg -highlightthickness 0 -text "Save\ - information I enter in web page forms and the Search Bar" \ - -variable ::cbvar($f.cb1) - } - set ::cbvar($f.cb1) 1 - pack $f.t1 -side top -anchor w -fill x -padx {0 8} -pady {0 4} - pack $f.cb1 -side top -anchor w + text $f.t1 -background $textBg -borderwidth 0 -highlightthickness 0 \ + -width 10 -height 1 -wrap word -cursor "" + $f.t1 insert end "Information entered in web page forms and the Search\ + Bar is saved to make filling out forms and searching faster." + bindtags $f.t1 TextWrapBindTag + if {$::tile} { + $::checkbuttonCmd $f.cb1 -text "Save information I enter in web page forms and the Search Bar" \ + -variable ::cbvar($f.cb1) -style DemoCheckbutton + } else { + checkbutton $f.cb1 -background $bg -highlightthickness 0 -text "Save\ + information I enter in web page forms and the Search Bar" \ + -variable ::cbvar($f.cb1) + } + set ::cbvar($f.cb1) 1 + pack $f.t1 -side top -anchor w -fill x -padx {0 8} -pady {0 4} + pack $f.cb1 -side top -anchor w if {$::clip} { - $T item element configure $I C0 eWindow -window $wClip + $T item element configure $I C0 eWindow -window $wClip } else { - $T item element configure $I C0 eWindow -window $f + $T item element configure $I C0 eWindow -window $f } - $T item lastchild "root child 1" $I + $T item lastchild "root child 1" $I - # Saved Passwords - set I [$T item create] - $T item style set $I C0 styFrame + # Saved Passwords + set I [$T item create] + $T item style set $I C0 styFrame if {$::clip} { - set wClip [frame $T.clip$I -background red] - set f [frame $wClip.f$I -borderwidth 0 -background $bg] + set wClip [frame $T.clip$I -background red] + set f [frame $wClip.f$I -borderwidth 0 -background $bg] } else { - set f [frame $T.f$I -borderwidth 0 -background $bg] + set f [frame $T.f$I -borderwidth 0 -background $bg] } - set fLeft [frame $f.fLeft -borderwidth 0 -background $bg] - text $fLeft.t1 -background $textBg -borderwidth 0 -highlightthickness 0 \ - -width 10 -height 1 -wrap word -cursor "" - $fLeft.t1 insert end "Login information for web pages can be kept in the\ - Password Manager so that you do not need to re-enter your login\ - details every time you visit." - bindtags $fLeft.t1 TextWrapBindTag - if {$::tile} { - $::checkbuttonCmd $fLeft.cb1 -text "Remember Passwords" \ - -variable ::cbvar($fLeft.cb1) -style DemoCheckbutton - } else { - checkbutton $fLeft.cb1 -background $bg -highlightthickness 0 \ - -text "Remember Passwords" -variable ::cbvar($fLeft.cb1) - } - set ::cbvar($fLeft.cb1) 1 - pack $fLeft.t1 -side top -expand yes -fill x -pady {0 6} - pack $fLeft.cb1 -side top -anchor w - - set fRight [frame $f.fRight -borderwidth 0 -background $bg] - $::buttonCmd $fRight.b1 -text "View Saved Passwords" - $::buttonCmd $fRight.b2 -text "Change Master Password..." - pack $fRight.b1 -side top -expand yes -fill x - pack $fRight.b2 -side top -expand yes -fill x -pady {8 0} - pack $fLeft -side left -expand yes -fill x - pack $fRight -side right -padx 12 -anchor n + set fLeft [frame $f.fLeft -borderwidth 0 -background $bg] + text $fLeft.t1 -background $textBg -borderwidth 0 -highlightthickness 0 \ + -width 10 -height 1 -wrap word -cursor "" + $fLeft.t1 insert end "Login information for web pages can be kept in the\ + Password Manager so that you do not need to re-enter your login\ + details every time you visit." + bindtags $fLeft.t1 TextWrapBindTag + if {$::tile} { + $::checkbuttonCmd $fLeft.cb1 -text "Remember Passwords" \ + -variable ::cbvar($fLeft.cb1) -style DemoCheckbutton + } else { + checkbutton $fLeft.cb1 -background $bg -highlightthickness 0 \ + -text "Remember Passwords" -variable ::cbvar($fLeft.cb1) + } + set ::cbvar($fLeft.cb1) 1 + pack $fLeft.t1 -side top -expand yes -fill x -pady {0 6} + pack $fLeft.cb1 -side top -anchor w + + set fRight [frame $f.fRight -borderwidth 0 -background $bg] + $::buttonCmd $fRight.b1 -text "View Saved Passwords" + $::buttonCmd $fRight.b2 -text "Change Master Password..." + pack $fRight.b1 -side top -expand yes -fill x + pack $fRight.b2 -side top -expand yes -fill x -pady {8 0} + pack $fLeft -side left -expand yes -fill x + pack $fRight -side right -padx 12 -anchor n if {$::clip} { - $T item element configure $I C0 eWindow -window $wClip + $T item element configure $I C0 eWindow -window $wClip } else { - $T item element configure $I C0 eWindow -window $f + $T item element configure $I C0 eWindow -window $f } - $T item lastchild "root child 2" $I + $T item lastchild "root child 2" $I - # Download Manager History - set I [$T item create] - $T item style set $I C0 styFrame + # Download Manager History + set I [$T item create] + $T item style set $I C0 styFrame if {$::clip} { - set wClip [frame $T.clip$I -background red] - set f [frame $wClip.f$I -borderwidth 0 -background $bg] + set wClip [frame $T.clip$I -background red] + set f [frame $wClip.f$I -borderwidth 0 -background $bg] } else { - set f [frame $T.f$I -borderwidth 0 -background $bg] + set f [frame $T.f$I -borderwidth 0 -background $bg] } - text $f.t1 -background $textBg -borderwidth 0 -highlightthickness 0 \ - -width 10 -height 1 -wrap word -cursor "" - $f.t1 insert end "The Download Manager keeps track of recently downloaded files." - bindtags $f.t1 TextWrapBindTag - - set f1 [frame $f.f1 -borderwidth 0 -background $bg] - label $f1.l1 -background $bg -text "Remove files from the Download Manager:" - if {$::tile} { - ttk::combobox $f1.mb1 -values { - "Upon successful download" - "When firefox exits" - Manually - } -state readonly -width [string length "Upon successful download"] - $f1.mb1 current 2 - } else { - menubutton $f1.mb1 -indicatoron yes -menu $f1.mb1.m -text Manually \ - -width [string length "Upon successful download"] -justify left - set m [menu $f1.mb1.m -tearoff no] - foreach label { - "Upon successful download" - "When firefox exits" - Manually} { - $m add command -label $label -command [list $f1.mb1 configure\ - -text $label] - } + text $f.t1 -background $textBg -borderwidth 0 -highlightthickness 0 \ + -width 10 -height 1 -wrap word -cursor "" + $f.t1 insert end "The Download Manager keeps track of recently downloaded files." + bindtags $f.t1 TextWrapBindTag + + set f1 [frame $f.f1 -borderwidth 0 -background $bg] + label $f1.l1 -background $bg -text "Remove files from the Download Manager:" + if {$::tile} { + ttk::combobox $f1.mb1 -values { + "Upon successful download" + "When firefox exits" + Manually + } -state readonly -width [string length "Upon successful download"] + $f1.mb1 current 2 + } else { + menubutton $f1.mb1 -indicatoron yes -menu $f1.mb1.m -text Manually \ + -width [string length "Upon successful download"] -justify left + set m [menu $f1.mb1.m -tearoff no] + foreach label { + "Upon successful download" + "When firefox exits" + Manually} { + $m add command -label $label -command [list $f1.mb1 configure\ + -text $label] } - pack $f1.l1 -side left - pack $f1.mb1 -side left -padx {8 10} - pack $f.t1 -side top -expand yes -fill x -padx {0 10} - pack $f1 -side top -anchor w + } + pack $f1.l1 -side left + pack $f1.mb1 -side left -padx {8 10} + pack $f.t1 -side top -expand yes -fill x -padx {0 10} + pack $f1 -side top -anchor w if {$::clip} { - $T item element configure $I C0 eWindow -window $wClip + $T item element configure $I C0 eWindow -window $wClip } else { - $T item element configure $I C0 eWindow -window $f + $T item element configure $I C0 eWindow -window $f } - $T item lastchild "root child 3" $I + $T item lastchild "root child 3" $I - # Cookies - set I [$T item create] - $T item style set $I C0 styFrame + # Cookies + set I [$T item create] + $T item style set $I C0 styFrame if {$::clip} { - set wClip [frame $T.clip$I -background red] - set f [frame $wClip.f$I -borderwidth 0 -background $bg] + set wClip [frame $T.clip$I -background red] + set f [frame $wClip.f$I -borderwidth 0 -background $bg] } else { - set f [frame $T.f$I -borderwidth 0 -background $bg] + set f [frame $T.f$I -borderwidth 0 -background $bg] } - text $f.t1 -background $textBg -borderwidth 0 -highlightthickness 0 \ - -width 10 -height 1 -wrap word -cursor "" - $f.t1 insert end "Cookies are pieces of information stored by web pages\ - on your computer. They are used to remember login information and\ - other data." - bindtags $f.t1 TextWrapBindTag - - set fLeft [frame $f.fLeft -borderwidth 0 -background $bg] - if {$::tile} { - $::checkbuttonCmd $fLeft.cb1 -style DemoCheckbutton \ - -text "Allow sites to set cookies" -variable ::cbvar($fLeft.cb1) - } else { - checkbutton $fLeft.cb1 -background $bg -highlightthickness 0 \ - -text "Allow sites to set cookies" -variable ::cbvar($fLeft.cb1) - } - set ::cbvar($fLeft.cb1) 1 - if {$::tile} { - $::checkbuttonCmd $fLeft.cb2 -style DemoCheckbutton \ - -text "for the originating web site only" \ - -variable ::cbar($fLeft.cb2) - } else { - checkbutton $fLeft.cb2 -background $bg -highlightthickness 0 \ - -text "for the originating web site only" \ - -variable ::cbar($fLeft.cb2) - } - set ::cbar($fLeft.cb2) 0 - pack $fLeft.cb1 -side top -anchor w - pack $fLeft.cb2 -side top -anchor w -padx {20 0} - - set fRight [frame $f.fRight -borderwidth 0 -background $bg] - $::buttonCmd $fRight.b1 -text "Exceptions" - $::buttonCmd $fRight.b2 -text "View Cookies" - pack $fRight.b1 -side left -padx {0 10} - pack $fRight.b2 -side left - - set f1 [frame $fLeft.f1 -borderwidth 0 -background $bg] - label $f1.l1 -background $bg -text "Keep Cookies:" - if {$::tile} { - ttk::combobox $f1.mb1 -values { - "until they expire" - "until I close Firefox" - "ask me every time" - } -state readonly -width [string length "until I close Firefox"] - $f1.mb1 current 0 - } else { - menubutton $f1.mb1 -indicatoron yes -menu $f1.mb1.m \ - -text "until they expire" \ - -width [string length "until I close Firefox"] -justify left - set m [menu $f1.mb1.m -tearoff no] - foreach label { - "until they expire" - "until I close Firefox" - "ask me every time" - } { - $m add command -label $label -command [list $f1.mb1 configure -text $label] - } + text $f.t1 -background $textBg -borderwidth 0 -highlightthickness 0 \ + -width 10 -height 1 -wrap word -cursor "" + $f.t1 insert end "Cookies are pieces of information stored by web pages\ + on your computer. They are used to remember login information and\ + other data." + bindtags $f.t1 TextWrapBindTag + + set fLeft [frame $f.fLeft -borderwidth 0 -background $bg] + if {$::tile} { + $::checkbuttonCmd $fLeft.cb1 -style DemoCheckbutton \ + -text "Allow sites to set cookies" -variable ::cbvar($fLeft.cb1) + } else { + checkbutton $fLeft.cb1 -background $bg -highlightthickness 0 \ + -text "Allow sites to set cookies" -variable ::cbvar($fLeft.cb1) + } + set ::cbvar($fLeft.cb1) 1 + if {$::tile} { + $::checkbuttonCmd $fLeft.cb2 -style DemoCheckbutton \ + -text "for the originating web site only" \ + -variable ::cbar($fLeft.cb2) + } else { + checkbutton $fLeft.cb2 -background $bg -highlightthickness 0 \ + -text "for the originating web site only" \ + -variable ::cbar($fLeft.cb2) + } + set ::cbar($fLeft.cb2) 0 + pack $fLeft.cb1 -side top -anchor w + pack $fLeft.cb2 -side top -anchor w -padx {20 0} + + set fRight [frame $f.fRight -borderwidth 0 -background $bg] + $::buttonCmd $fRight.b1 -text "Exceptions" + $::buttonCmd $fRight.b2 -text "View Cookies" + pack $fRight.b1 -side left -padx {0 10} + pack $fRight.b2 -side left + + set f1 [frame $fLeft.f1 -borderwidth 0 -background $bg] + label $f1.l1 -background $bg -text "Keep Cookies:" + if {$::tile} { + ttk::combobox $f1.mb1 -values { + "until they expire" + "until I close Firefox" + "ask me every time" + } -state readonly -width [string length "until I close Firefox"] + $f1.mb1 current 0 + } else { + menubutton $f1.mb1 -indicatoron yes -menu $f1.mb1.m \ + -text "until they expire" \ + -width [string length "until I close Firefox"] -justify left + set m [menu $f1.mb1.m -tearoff no] + foreach label { + "until they expire" + "until I close Firefox" + "ask me every time" + } { + $m add command -label $label -command [list $f1.mb1 configure -text $label] } - pack $f1.l1 -side left - pack $f1.mb1 -side left -padx {8 0} - pack $f1 -side top -anchor w - - pack $f.t1 -side top -expand yes -fill x -padx {0 10} -pady {0 8} - pack $fLeft -side left -expand yes -fill x - pack $fRight -side right -padx 14 -anchor n + } + pack $f1.l1 -side left + pack $f1.mb1 -side left -padx {8 0} + pack $f1 -side top -anchor w + + pack $f.t1 -side top -expand yes -fill x -padx {0 10} -pady {0 8} + pack $fLeft -side left -expand yes -fill x + pack $fRight -side right -padx 14 -anchor n if {$::clip} { - $T item element configure $I C0 eWindow -window $wClip + $T item element configure $I C0 eWindow -window $wClip } else { - $T item element configure $I C0 eWindow -window $f + $T item element configure $I C0 eWindow -window $f } - $T item lastchild "root child 4" $I + $T item lastchild "root child 4" $I - # Cache - set I [$T item create] - $T item style set $I C0 styFrame + # Cache + set I [$T item create] + $T item style set $I C0 styFrame if {$::clip} { - set wClip [frame $T.clip$I -background red] - set f [frame $wClip.f$I -borderwidth 0 -background $bg] + set wClip [frame $T.clip$I -background red] + set f [frame $wClip.f$I -borderwidth 0 -background $bg] } else { - set f [frame $T.f$I -borderwidth 0 -background $bg] + set f [frame $T.f$I -borderwidth 0 -background $bg] } - text $f.t1 -background $textBg -borderwidth 0 -highlightthickness 0 \ - -width 10 -height 1 -wrap word -cursor "" - $f.t1 insert end "Pages you view are stored in the cache for quicker\ - viewing later on." - bindtags $f.t1 TextWrapBindTag - set f1 [frame $f.f1 -borderwidth 0 -background $bg] - label $f1.l1 -background $bg -text "Use up to:" - $::entryCmd $f1.e1 -width 10 - $f1.e1 insert end 50000 - label $f1.l2 -background $bg -text "KB of disk space for the cache." \ - -background $bg - pack $f1.l1 -side left - pack $f1.e1 -side left -padx 8 - pack $f1.l2 -side left - pack $f.t1 -side top -expand yes -fill x -padx {0 10} - pack $f1 -side top -anchor w + text $f.t1 -background $textBg -borderwidth 0 -highlightthickness 0 \ + -width 10 -height 1 -wrap word -cursor "" + $f.t1 insert end "Pages you view are stored in the cache for quicker\ + viewing later on." + bindtags $f.t1 TextWrapBindTag + set f1 [frame $f.f1 -borderwidth 0 -background $bg] + label $f1.l1 -background $bg -text "Use up to:" + $::entryCmd $f1.e1 -width 10 + $f1.e1 insert end 50000 + label $f1.l2 -background $bg -text "KB of disk space for the cache." \ + -background $bg + pack $f1.l1 -side left + pack $f1.e1 -side left -padx 8 + pack $f1.l2 -side left + pack $f.t1 -side top -expand yes -fill x -padx {0 10} + pack $f1 -side top -anchor w if {$::clip} { - $T item element configure $I C0 eWindow -window $wClip + $T item element configure $I C0 eWindow -window $wClip } else { - $T item element configure $I C0 eWindow -window $f + $T item element configure $I C0 eWindow -window $f } - $T item lastchild "root child 5" $I - - # This binding configures the -height option of a Text widget to the - # number of lines it is displaying - bind TextWrapBindTag { - scan [textlayout [%W cget -font] [%W get 1.0 "end - 1 chars"] \ - -width %w] "%%d %%d" width height - set height [expr {$height / [font metrics [%W cget -font] -linespace]}] - if {$height != [%W cget -height]} { - %W configure -height $height - } + $T item lastchild "root child 5" $I + + # This binding configures the -height option of a Text widget to the + # number of lines it is displaying + bind TextWrapBindTag { + scan [textlayout [%W cget -font] [%W get 1.0 "end - 1 chars"] \ + -width %w] "%%d %%d" width height + set height [expr {$height / [font metrics [%W cget -font] -linespace]}] + if {$height != [%W cget -height]} { + %W configure -height $height } + } - # This binding collapses all items before expanding a new one - $T notify bind $T { - %T item collapse all - } - $T item collapse all + # This binding collapses all items before expanding a new one + $T notify bind $T { + %T item collapse all + } + $T item collapse all - bind DemoFirefoxPrivacy { - if {[lindex [%W identify %x %y] 0] eq "header"} { - TreeCtrl::DoubleButton1 %W %x %y - } else { - DemoFirefoxPrivacyButton1 %W %x %y - } - break - } - bind DemoFirefoxPrivacy { - DemoFirefoxPrivacyButton1 %W %x %y - break - } - bind DemoFirefoxPrivacy { - # noop - } - bind DemoFirefoxPrivacy { - # noop - } - bind DemoFirefoxPrivacy { - DemoFirefoxPrivacyMotion %W %x %y + bind DemoFirefoxPrivacy { + if {[lindex [%W identify %x %y] 0] eq "header"} { + TreeCtrl::DoubleButton1 %W %x %y + } else { + DemoFirefoxPrivacyButton1 %W %x %y } - bind DemoFirefoxPrivacy { - DemoFirefoxPrivacyMotion %W %x %y + break + } + bind DemoFirefoxPrivacy { + DemoFirefoxPrivacyButton1 %W %x %y + break + } + bind DemoFirefoxPrivacy { + # noop + } + bind DemoFirefoxPrivacy { + # noop + } + bind DemoFirefoxPrivacy { + DemoFirefoxPrivacyMotion %W %x %y + } + bind DemoFirefoxPrivacy { + DemoFirefoxPrivacyMotion %W %x %y + } + + if {$::tile} { + bind DemoFirefoxPrivacy <> { + ttk::style configure DemoCheckbutton -background #FFFFCC + ttk::style layout DemoCheckbutton [ttk::style layout TCheckbutton] } + } - if {$::tile} { - bind DemoFirefoxPrivacy <> { - ttk::style configure DemoCheckbutton -background #FFFFCC - ttk::style layout DemoCheckbutton [ttk::style layout TCheckbutton] - } - } + set FirefoxPrivacy(prev) "" + bindtags $T [list $T DemoFirefoxPrivacy TreeCtrl [winfo toplevel $T] all] - set FirefoxPrivacy(prev) "" - bindtags $T [list $T DemoFirefoxPrivacy TreeCtrl [winfo toplevel $T] all] - - return + return } proc DemoFirefoxPrivacyButton1 {w x y} { - variable TreeCtrl::Priv - focus $w - set id [$w identify $x $y] - set Priv(buttonMode) "" - if {[lindex $id 0] eq "header"} { - TreeCtrl::ButtonPress1 $w $x $y - } elseif {[lindex $id 0] eq "item"} { - set item [lindex $id 1] - # click a button - if {[llength $id] != 6} { - TreeCtrl::ButtonPress1 $w $x $y - return - } - if {[lindex $id 5] eq "eText1"} { - $w item toggle $item - DisplayStylesInItem $item - } + variable TreeCtrl::Priv + focus $w + set id [$w identify $x $y] + set Priv(buttonMode) "" + if {[lindex $id 0] eq "header"} { + TreeCtrl::ButtonPress1 $w $x $y + } elseif {[lindex $id 0] eq "item"} { + set item [lindex $id 1] + # click a button + if {[llength $id] != 6} { + TreeCtrl::ButtonPress1 $w $x $y + return + } + if {[lindex $id 5] eq "eText1"} { + $w item toggle $item + DisplayStylesInItem $item } - return + } + return } proc DemoFirefoxPrivacyMotion {w x y} { - global FirefoxPrivacy - set id [$w identify $x $y] - if {[lindex $id 0] eq "item"} { - set item [lindex $id 1] - if {[llength $id] == 6 && [lindex $id 5] eq "eText1"} { - if {$item ne $FirefoxPrivacy(prev)} { - $w configure -cursor hand2 - set FirefoxPrivacy(prev) $item - } - return - } + global FirefoxPrivacy + set id [$w identify $x $y] + if {[lindex $id 0] eq "item"} { + set item [lindex $id 1] + if {[llength $id] == 6 && [lindex $id 5] eq "eText1"} { + if {$item ne $FirefoxPrivacy(prev)} { + $w configure -cursor hand2 + set FirefoxPrivacy(prev) $item + } + return } - if {$FirefoxPrivacy(prev) ne ""} { - $w configure -cursor "" - set FirefoxPrivacy(prev) "" - } - return + } + if {$FirefoxPrivacy(prev) ne ""} { + $w configure -cursor "" + set FirefoxPrivacy(prev) "" + } + return } diff --git a/demos/help.tcl b/demos/help.tcl index ff2cf14..a4d9172 100644 --- a/demos/help.tcl +++ b/demos/help.tcl @@ -1,363 +1,363 @@ -# RCS: @(#) $Id: help.tcl,v 1.20 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: help.tcl,v 1.21 2006/11/30 02:41:38 treectrl Exp $ # # Demo: Help contents # proc DemoHelpContents {} { - global HelpContents - - set T [DemoList] - - set height [font metrics [$T cget -font] -linespace] - if {$height < 18} { - set height 18 + global HelpContents + + set T [DemoList] + + set height [font metrics [$T cget -font] -linespace] + if {$height < 18} { + set height 18 + } + + # + # Configure the treectrl widget + # + + $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ + -selectmode browse + + InitPics help-* + + # + # Create columns + # + + $T column create -text "Help Contents" -tags C0 + + $T configure -treecolumn C0 + + # + # Create elements + # + + # Define a new item state + $T state define mouseover + + $T element create elemImgPage image -image help-page + $T element create elemImgBook image -image {help-book-open {open} help-book-closed {}} + $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus} blue {mouseover}] \ + -font [list "[$T cget -font] underline" {mouseover}] + $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus}] -showfocus yes + + # + # Create styles using the elements + # + + # book + set S [$T style create styBook] + $T style elements $S {elemRectSel elemImgBook elemTxt} + $T style layout $S elemImgBook -padx {0 4} -expand ns + $T style layout $S elemTxt -expand ns + $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 + + # page + set S [$T style create styPage] + $T style elements $S {elemRectSel elemImgPage elemTxt} + $T style layout $S elemImgPage -padx {0 4} -expand ns + $T style layout $S elemTxt -expand ns + $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 + + # + # Create items and assign styles + # + + set parentList [list root {} {} {} {} {} {}] + set parent root + foreach {depth style text} { + 0 styPage "Welcome to Help" + 0 styBook "Introducing Windows 98" + 1 styBook "How to Use Help" + 2 styPage "Find a topic" + 2 styPage "Get more out of help" + 1 styBook "Register Your Software" + 2 styPage "Registering Windows 98 online" + 1 styBook "What's New in Windows 98" + 2 styPage "Innovative, easy-to-use features" + 2 styPage "Improved reliability" + 2 styPage "A faster operating system" + 2 styPage "True Web integration" + 2 styPage "More entertaining and fun" + 1 styBook "If You're New to Windows 98" + 2 styBook "Tips for Macintosh Users" + 3 styPage "Why does the mouse have two buttons?" + } { + set item [$T item create -open no] + $T item style set $item C0 $style + $T item element configure $item C0 elemTxt -text $text + $T item lastchild [lindex $parentList $depth] $item + incr depth + set parentList [lreplace $parentList $depth $depth $item] + } + + bind DemoHelpContents { + if {[lindex [%W identify %x %y] 0] eq "header"} { + TreeCtrl::DoubleButton1 %W %x %y + } else { + HelpButton1 %W %x %y } - - # - # Configure the treectrl widget - # - - $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ - -selectmode browse - - InitPics help-* - - # - # Create columns - # - - $T column create -text "Help Contents" -tags C0 - - $T configure -treecolumn C0 - - # - # Create elements - # - - # Define a new item state - $T state define mouseover - - $T element create elemImgPage image -image help-page - $T element create elemImgBook image -image {help-book-open {open} help-book-closed {}} - $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus} blue {mouseover}] \ - -font [list "[$T cget -font] underline" {mouseover}] - $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus}] -showfocus yes - - # - # Create styles using the elements - # - - # book - set S [$T style create styBook] - $T style elements $S {elemRectSel elemImgBook elemTxt} - $T style layout $S elemImgBook -padx {0 4} -expand ns - $T style layout $S elemTxt -expand ns - $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 - - # page - set S [$T style create styPage] - $T style elements $S {elemRectSel elemImgPage elemTxt} - $T style layout $S elemImgPage -padx {0 4} -expand ns - $T style layout $S elemTxt -expand ns - $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 - - # - # Create items and assign styles - # - - set parentList [list root {} {} {} {} {} {}] - set parent root - foreach {depth style text} { - 0 styPage "Welcome to Help" - 0 styBook "Introducing Windows 98" - 1 styBook "How to Use Help" - 2 styPage "Find a topic" - 2 styPage "Get more out of help" - 1 styBook "Register Your Software" - 2 styPage "Registering Windows 98 online" - 1 styBook "What's New in Windows 98" - 2 styPage "Innovative, easy-to-use features" - 2 styPage "Improved reliability" - 2 styPage "A faster operating system" - 2 styPage "True Web integration" - 2 styPage "More entertaining and fun" - 1 styBook "If You're New to Windows 98" - 2 styBook "Tips for Macintosh Users" - 3 styPage "Why does the mouse have two buttons?" - } { - set item [$T item create -open no] - $T item style set $item C0 $style - $T item element configure $item C0 elemTxt -text $text - $T item lastchild [lindex $parentList $depth] $item - incr depth - set parentList [lreplace $parentList $depth $depth $item] + break + } + bind DemoHelpContents { + HelpButton1 %W %x %y + break + } + bind DemoHelpContents { + # noop + } + bind DemoHelpContents { + # noop + } + bind DemoHelpContents { + HelpMotion %W %x %y + } + bind DemoHelpContents { + HelpMotion %W %x %y + } + bind DemoHelpContents { + if {[%W selection count] == 1} { + %W item toggle [%W selection get 0] } + break + } - bind DemoHelpContents { - if {[lindex [%W identify %x %y] 0] eq "header"} { - TreeCtrl::DoubleButton1 %W %x %y - } else { - HelpButton1 %W %x %y - } - break - } - bind DemoHelpContents { - HelpButton1 %W %x %y - break - } - bind DemoHelpContents { - # noop - } - bind DemoHelpContents { - # noop - } - bind DemoHelpContents { - HelpMotion %W %x %y - } - bind DemoHelpContents { - HelpMotion %W %x %y - } - bind DemoHelpContents { - if {[%W selection count] == 1} { - %W item toggle [%W selection get 0] - } - break - } - - set HelpContents(prev) "" - bindtags $T [list $T DemoHelpContents TreeCtrl [winfo toplevel $T] all] + set HelpContents(prev) "" + bindtags $T [list $T DemoHelpContents TreeCtrl [winfo toplevel $T] all] - return + return } # This is an alternate implementation that does not define a new item state # to change the appearance of the item under the cursor. proc DemoHelpContents_2 {} { - global HelpContents - - set T [DemoList] - - set height [font metrics [$T cget -font] -linespace] - if {$height < 18} { - set height 18 - } - - # - # Configure the treectrl widget - # - - $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ - -selectmode browse - - InitPics help-* - - # - # Create columns - # - - $T column create -text "Help Contents" - - # - # Create elements - # - - $T element create elemImgPage image -image help-page - $T element create elemImgBook image -image {help-book-open {open} help-book-closed {}} - $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] - $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus}] -showfocus yes - $T element create elemTxtOver text -fill [list $::SystemHighlightText {selected focus} blue {}] \ - -font "[$T cget -font] underline" - - # - # Create styles using the elements - # - - # book - set S [$T style create styBook] - $T style elements $S {elemRectSel elemImgBook elemTxt} - $T style layout $S elemImgBook -padx {0 4} -expand ns - $T style layout $S elemTxt -expand ns - $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 - - # page - set S [$T style create styPage] - $T style elements $S {elemRectSel elemImgPage elemTxt} - $T style layout $S elemImgPage -padx {0 4} -expand ns - $T style layout $S elemTxt -expand ns - $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 - - # book (focus) - set S [$T style create styBook.f] - $T style elements $S {elemRectSel elemImgBook elemTxtOver} - $T style layout $S elemImgBook -padx {0 4} -expand ns - $T style layout $S elemTxtOver -expand ns - $T style layout $S elemRectSel -union [list elemTxtOver] -iexpand ns -ipadx {1 2} - - # page (focus) - set S [$T style create styPage.f] - $T style elements $S {elemRectSel elemImgPage elemTxtOver} - $T style layout $S elemImgPage -padx {0 4} -expand ns - $T style layout $S elemTxtOver -expand ns - $T style layout $S elemRectSel -union [list elemTxtOver] -iexpand ns -ipadx {1 2} - - # - # Create items and assign styles - # - - set parentList [list root {} {} {} {} {} {}] - set parent root - foreach {depth style text} { - 0 styPage "Welcome to Help" - 0 styBook "Introducing Windows 98" - 1 styBook "How to Use Help" - 2 styPage "Find a topic" - 2 styPage "Get more out of help" - 1 styBook "Register Your Software" - 2 styPage "Registering Windows 98 online" - 1 styBook "What's New in Windows 98" - 2 styPage "Innovative, easy-to-use features" - 2 styPage "Improved reliability" - 2 styPage "A faster operating system" - 2 styPage "True Web integration" - 2 styPage "More entertaining and fun" - 1 styBook "If You're New to Windows 98" - 2 styBook "Tips for Macintosh Users" - 3 styPage "Why does the mouse have two buttons?" - } { - set item [$T item create -open no] - $T item style set $item 0 $style - $T item element configure $item 0 elemTxt -text $text - $T item lastchild [lindex $parentList $depth] $item - incr depth - set parentList [lreplace $parentList $depth $depth $item] - } - - bind DemoHelpContents { - if {[lindex [%W identify %x %y] 0] eq "header"} { - TreeCtrl::DoubleButton1 %W %x %y - } else { - HelpButton1 %W %x %y - } - break - } - bind DemoHelpContents { - HelpButton1 %W %x %y - break + global HelpContents + + set T [DemoList] + + set height [font metrics [$T cget -font] -linespace] + if {$height < 18} { + set height 18 + } + + # + # Configure the treectrl widget + # + + $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ + -selectmode browse + + InitPics help-* + + # + # Create columns + # + + $T column create -text "Help Contents" + + # + # Create elements + # + + $T element create elemImgPage image -image help-page + $T element create elemImgBook image -image {help-book-open {open} help-book-closed {}} + $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] + $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus}] -showfocus yes + $T element create elemTxtOver text -fill [list $::SystemHighlightText {selected focus} blue {}] \ + -font "[$T cget -font] underline" + + # + # Create styles using the elements + # + + # book + set S [$T style create styBook] + $T style elements $S {elemRectSel elemImgBook elemTxt} + $T style layout $S elemImgBook -padx {0 4} -expand ns + $T style layout $S elemTxt -expand ns + $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 + + # page + set S [$T style create styPage] + $T style elements $S {elemRectSel elemImgPage elemTxt} + $T style layout $S elemImgPage -padx {0 4} -expand ns + $T style layout $S elemTxt -expand ns + $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 + + # book (focus) + set S [$T style create styBook.f] + $T style elements $S {elemRectSel elemImgBook elemTxtOver} + $T style layout $S elemImgBook -padx {0 4} -expand ns + $T style layout $S elemTxtOver -expand ns + $T style layout $S elemRectSel -union [list elemTxtOver] -iexpand ns -ipadx {1 2} + + # page (focus) + set S [$T style create styPage.f] + $T style elements $S {elemRectSel elemImgPage elemTxtOver} + $T style layout $S elemImgPage -padx {0 4} -expand ns + $T style layout $S elemTxtOver -expand ns + $T style layout $S elemRectSel -union [list elemTxtOver] -iexpand ns -ipadx {1 2} + + # + # Create items and assign styles + # + + set parentList [list root {} {} {} {} {} {}] + set parent root + foreach {depth style text} { + 0 styPage "Welcome to Help" + 0 styBook "Introducing Windows 98" + 1 styBook "How to Use Help" + 2 styPage "Find a topic" + 2 styPage "Get more out of help" + 1 styBook "Register Your Software" + 2 styPage "Registering Windows 98 online" + 1 styBook "What's New in Windows 98" + 2 styPage "Innovative, easy-to-use features" + 2 styPage "Improved reliability" + 2 styPage "A faster operating system" + 2 styPage "True Web integration" + 2 styPage "More entertaining and fun" + 1 styBook "If You're New to Windows 98" + 2 styBook "Tips for Macintosh Users" + 3 styPage "Why does the mouse have two buttons?" + } { + set item [$T item create -open no] + $T item style set $item 0 $style + $T item element configure $item 0 elemTxt -text $text + $T item lastchild [lindex $parentList $depth] $item + incr depth + set parentList [lreplace $parentList $depth $depth $item] + } + + bind DemoHelpContents { + if {[lindex [%W identify %x %y] 0] eq "header"} { + TreeCtrl::DoubleButton1 %W %x %y + } else { + HelpButton1 %W %x %y } - bind DemoHelpContents { - # noop - } - bind DemoHelpContents { - # noop - } - bind DemoHelpContents { - HelpMotion_2 %W %x %y - } - bind DemoHelpContents { - HelpMotion_2 %W %x %y - } - bind DemoHelpContents { - if {[%W selection count] == 1} { - %W item toggle [%W selection get 0] - } - break + break + } + bind DemoHelpContents { + HelpButton1 %W %x %y + break + } + bind DemoHelpContents { + # noop + } + bind DemoHelpContents { + # noop + } + bind DemoHelpContents { + HelpMotion_2 %W %x %y + } + bind DemoHelpContents { + HelpMotion_2 %W %x %y + } + bind DemoHelpContents { + if {[%W selection count] == 1} { + %W item toggle [%W selection get 0] } + break + } - set HelpContents(prev) "" - bindtags $T [list $T DemoHelpContents TreeCtrl [winfo toplevel $T] all] + set HelpContents(prev) "" + bindtags $T [list $T DemoHelpContents TreeCtrl [winfo toplevel $T] all] - return + return } proc HelpButton1 {w x y} { - variable TreeCtrl::Priv - focus $w - set id [$w identify $x $y] - set Priv(buttonMode) "" - if {[lindex $id 0] eq "header"} { - TreeCtrl::ButtonPress1 $w $x $y - } elseif {[lindex $id 0] eq "item"} { - set item [lindex $id 1] - # didn't click an element - if {[llength $id] != 6} return - if {[$w selection includes $item]} { - $w item toggle $item - return - } - if {[$w selection count]} { - set item2 [$w selection get 0] - $w item collapse $item2 - foreach item2 [$w item ancestors $item2] { - if {[$w item compare $item != $item2]} { - $w item collapse $item2 - } - } + variable TreeCtrl::Priv + focus $w + set id [$w identify $x $y] + set Priv(buttonMode) "" + if {[lindex $id 0] eq "header"} { + TreeCtrl::ButtonPress1 $w $x $y + } elseif {[lindex $id 0] eq "item"} { + set item [lindex $id 1] + # didn't click an element + if {[llength $id] != 6} return + if {[$w selection includes $item]} { + $w item toggle $item + return + } + if {[$w selection count]} { + set item2 [$w selection get 0] + $w item collapse $item2 + foreach item2 [$w item ancestors $item2] { + if {[$w item compare $item != $item2]} { + $w item collapse $item2 } - $w activate $item - $w item expand [list $item ancestors] - $w item toggle $item - $w selection modify $item all + } } - return + $w activate $item + $w item expand [list $item ancestors] + $w item toggle $item + $w selection modify $item all + } + return } proc HelpMotion {w x y} { - global HelpContents - set id [$w identify $x $y] - if {$id eq ""} { - } elseif {[lindex $id 0] eq "header"} { - } elseif {[lindex $id 0] eq "item"} { - set item [lindex $id 1] - if {[llength $id] == 6} { - if {$item ne $HelpContents(prev)} { - if {$HelpContents(prev) ne ""} { - $w item state set $HelpContents(prev) !mouseover - } - $w item state set $item mouseover - $w configure -cursor hand2 - set HelpContents(prev) $item - } - return + global HelpContents + set id [$w identify $x $y] + if {$id eq ""} { + } elseif {[lindex $id 0] eq "header"} { + } elseif {[lindex $id 0] eq "item"} { + set item [lindex $id 1] + if {[llength $id] == 6} { + if {$item ne $HelpContents(prev)} { + if {$HelpContents(prev) ne ""} { + $w item state set $HelpContents(prev) !mouseover } + $w item state set $item mouseover + $w configure -cursor hand2 + set HelpContents(prev) $item + } + return } - if {$HelpContents(prev) ne ""} { - $w item state set $HelpContents(prev) !mouseover - $w configure -cursor "" - set HelpContents(prev) "" - } - return + } + if {$HelpContents(prev) ne ""} { + $w item state set $HelpContents(prev) !mouseover + $w configure -cursor "" + set HelpContents(prev) "" + } + return } # Alternate implementation that does not rely on run-time states proc HelpMotion_2 {w x y} { - variable TreeCtrl::Priv - global HelpContents - set id [$w identify $x $y] - if {[lindex $id 0] eq "header"} { - } elseif {$id ne ""} { - set item [lindex $id 1] - if {[llength $id] == 6} { - if {$item ne $HelpContents(prev)} { - if {$HelpContents(prev) ne ""} { - set style [$w item style set $HelpContents(prev) 0] - set style [string trim $style .f] - $w item style map $HelpContents(prev) 0 $style {elemTxtOver elemTxt} - } - set style [$w item style set $item 0] - $w item style map $item 0 $style.f {elemTxt elemTxtOver} - set HelpContents(prev) $item - } - return + variable TreeCtrl::Priv + global HelpContents + set id [$w identify $x $y] + if {[lindex $id 0] eq "header"} { + } elseif {$id ne ""} { + set item [lindex $id 1] + if {[llength $id] == 6} { + if {$item ne $HelpContents(prev)} { + if {$HelpContents(prev) ne ""} { + set style [$w item style set $HelpContents(prev) 0] + set style [string trim $style .f] + $w item style map $HelpContents(prev) 0 $style {elemTxtOver elemTxt} } + set style [$w item style set $item 0] + $w item style map $item 0 $style.f {elemTxt elemTxtOver} + set HelpContents(prev) $item + } + return } - if {$HelpContents(prev) ne ""} { - set style [$w item style set $HelpContents(prev) 0] - set style [string trim $style .f] - $w item style map $HelpContents(prev) 0 $style {elemTxtOver elemTxt} - set HelpContents(prev) "" - } - return + } + if {$HelpContents(prev) ne ""} { + set style [$w item style set $HelpContents(prev) 0] + set style [string trim $style .f] + $w item style map $HelpContents(prev) 0 $style {elemTxtOver elemTxt} + set HelpContents(prev) "" + } + return } diff --git a/demos/imovie.tcl b/demos/imovie.tcl index fa9707b..a988470 100644 --- a/demos/imovie.tcl +++ b/demos/imovie.tcl @@ -1,150 +1,150 @@ -# RCS: @(#) $Id: imovie.tcl,v 1.15 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: imovie.tcl,v 1.16 2006/11/30 02:41:38 treectrl Exp $ # # Demo: iMovie # proc DemoIMovie {} { - set T [DemoList] + set T [DemoList] - # - # Configure the treectrl widget - # + # + # Configure the treectrl widget + # - $T configure -showroot no -showbuttons no -showlines no \ - -selectmode browse -orient horizontal -wrap window \ - -showheader no -background #dcdcdc + $T configure -showroot no -showbuttons no -showlines no \ + -selectmode browse -orient horizontal -wrap window \ + -showheader no -background #dcdcdc - # - # Create columns - # + # + # Create columns + # - $T column create -tags C0 + $T column create -tags C0 - InitPics imovie-* + InitPics imovie-* - switch -- $::thisPlatform { - macintosh - - macosx { - set font1 {Geneva 9} - set font2 {Geneva 10} - } - unix { - set font1 {Helvetica 12} - set font2 {Helvetica 14} - } - default { - set font1 {Helvetica 8} - set font2 {Helvetica 10} - } + switch -- $::thisPlatform { + macintosh - + macosx { + set font1 {Geneva 9} + set font2 {Geneva 10} } - - # - # Create elements - # - - $T element create elemTime text -font [list $font1] - $T element create elemName text -font [list $font2] -lines 1 -width 80 - $T element create elemRect rect -fill {#ffdc5a {selected} white {}} \ - -outline #827878 -outlinewidth 1 - $T element create elemImg image - $T element create elemShadow rect -outline gray -outlinewidth 1 -open wn - - # - # Create styles using the elements - # - - set S [$T style create STYLE -orient vertical] - $T style elements $S {elemShadow elemRect elemTime elemImg elemName} - $T style layout $S elemShadow -detach yes -padx {1 2} -pady {1 2} -iexpand xy - $T style layout $S elemTime -padx {2 0} - $T style layout $S elemImg -pady {0 1} - $T style layout $S elemName -expand we -ipady {0 2} -padx {0 3} -squeeze x - $T style layout $S elemRect -union {elemTime elemImg elemName} \ - -ipadx 6 -padx {0 3} -pady {0 3} - - # Set default item style - $T column configure C0 -itemstyle $S - - # - # Create items and assign styles - # - - for {set i 0} {$i < 5} {incr i} { - foreach {time name image} { - 15:20 "Clip 1" imovie-01 - 19:18 "Clip 2" imovie-02 - 07:20 "Clip 3" imovie-03 - 07:20 "Clip 4" imovie-04 - 07:20 "Clip 5" imovie-05 - 07:20 "Clip 6" imovie-06 - 07:20 "Clip 7" imovie-07 - } { - set I [$T item create] + unix { + set font1 {Helvetica 12} + set font2 {Helvetica 14} + } + default { + set font1 {Helvetica 8} + set font2 {Helvetica 10} + } + } + + # + # Create elements + # + + $T element create elemTime text -font [list $font1] + $T element create elemName text -font [list $font2] -lines 1 -width 80 + $T element create elemRect rect -fill {#ffdc5a {selected} white {}} \ + -outline #827878 -outlinewidth 1 + $T element create elemImg image + $T element create elemShadow rect -outline gray -outlinewidth 1 -open wn + + # + # Create styles using the elements + # + + set S [$T style create STYLE -orient vertical] + $T style elements $S {elemShadow elemRect elemTime elemImg elemName} + $T style layout $S elemShadow -detach yes -padx {1 2} -pady {1 2} -iexpand xy + $T style layout $S elemTime -padx {2 0} + $T style layout $S elemImg -pady {0 1} + $T style layout $S elemName -expand we -ipady {0 2} -padx {0 3} -squeeze x + $T style layout $S elemRect -union {elemTime elemImg elemName} \ + -ipadx 6 -padx {0 3} -pady {0 3} + + # Set default item style + $T column configure C0 -itemstyle $S + + # + # Create items and assign styles + # + + for {set i 0} {$i < 5} {incr i} { + foreach {time name image} { + 15:20 "Clip 1" imovie-01 + 19:18 "Clip 2" imovie-02 + 07:20 "Clip 3" imovie-03 + 07:20 "Clip 4" imovie-04 + 07:20 "Clip 5" imovie-05 + 07:20 "Clip 6" imovie-06 + 07:20 "Clip 7" imovie-07 + } { + set I [$T item create] # $T item style set $I C0 $S - $T item element configure $I C0 \ - elemTime -text $time + \ - elemImg -image $image + \ - elemName -text $name - $T item lastchild root $I - } + $T item element configure $I C0 \ + elemTime -text $time + \ + elemImg -image $image + \ + elemName -text $name + $T item lastchild root $I } + } - $T notify bind $T { - %T item element configure %I %C %E -text %t - } + $T notify bind $T { + %T item element configure %I %C %E -text %t + } - bind DemoIMovie { - iMovieButton1 %W %x %y - } + bind DemoIMovie { + iMovieButton1 %W %x %y + } - bindtags $T [list $T DemoIMovie TreeCtrl [winfo toplevel $T] all] + bindtags $T [list $T DemoIMovie TreeCtrl [winfo toplevel $T] all] - return + return } proc iMovieButton1 {T x y} { - focus $T - set id [$T identify $x $y] - - # Click outside any item - if {$id eq ""} { - - # Click in header - } elseif {[lindex $id 0] eq "header"} { - ::TreeCtrl::ButtonPress1 $T $x $y - - # Click in item - } elseif {[lindex $id 0] eq "item"} { - ::TreeCtrl::ButtonPress1 $T $x $y - update - lassign $id where item arg1 arg2 arg3 arg4 - switch $arg1 { - column { - set I [lindex $id 1] - if {[llength $id] == 6} { - set E [lindex $id end] - if {$E eq "elemName"} { - set exists [winfo exists $T.entry] - ::TreeCtrl::EntryOpen $T $I C0 $E - if {!$exists} { - $T.entry configure -borderwidth 0 -justify center \ - -background #ffdc5a - scan [$T item bbox $I C0 $E] "%d %d %d %d" x1 y1 x2 y2 - place $T.entry -y [expr {$y1 - 1}] - } - $T.entry selection clear - scan [$T item bbox $I] "%d %d %d %d" x1 y1 x2 y2 - set left [expr {$x1 + 6 - 1}] - set right [expr {$x2 - 3 - 6 + 1}] - place $T.entry -x $left -width [expr {$right - $left}] - $T.entry icursor [$T.entry index @[expr {$x - ($x1 + 1)}]] - # Disable mouse tracking - unset ::TreeCtrl::Priv(buttonMode) - } - } + focus $T + set id [$T identify $x $y] + + # Click outside any item + if {$id eq ""} { + + # Click in header + } elseif {[lindex $id 0] eq "header"} { + ::TreeCtrl::ButtonPress1 $T $x $y + + # Click in item + } elseif {[lindex $id 0] eq "item"} { + ::TreeCtrl::ButtonPress1 $T $x $y + update + lassign $id where item arg1 arg2 arg3 arg4 + switch $arg1 { + column { + set I [lindex $id 1] + if {[llength $id] == 6} { + set E [lindex $id end] + if {$E eq "elemName"} { + set exists [winfo exists $T.entry] + ::TreeCtrl::EntryOpen $T $I C0 $E + if {!$exists} { + $T.entry configure -borderwidth 0 -justify center \ + -background #ffdc5a + scan [$T item bbox $I C0 $E] "%d %d %d %d" x1 y1 x2 y2 + place $T.entry -y [expr {$y1 - 1}] } + $T.entry selection clear + scan [$T item bbox $I] "%d %d %d %d" x1 y1 x2 y2 + set left [expr {$x1 + 6 - 1}] + set right [expr {$x2 - 3 - 6 + 1}] + place $T.entry -x $left -width [expr {$right - $left}] + $T.entry icursor [$T.entry index @[expr {$x - ($x1 + 1)}]] + # Disable mouse tracking + unset ::TreeCtrl::Priv(buttonMode) + } } + } } - return -code break + } + return -code break } diff --git a/demos/layout.tcl b/demos/layout.tcl index 2f96162..ad058cc 100644 --- a/demos/layout.tcl +++ b/demos/layout.tcl @@ -1,145 +1,145 @@ -# RCS: @(#) $Id: layout.tcl,v 1.12 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: layout.tcl,v 1.13 2006/11/30 02:41:38 treectrl Exp $ # # Demo: Layout # proc DemoLayout {} { - set T [DemoList] - - # - # Configure the treectrl widget - # - - $T configure -showroot no -showrootbutton yes -showbuttons yes \ - -showlines $::ShowLines -itemheight 0 -selectmode browse - - # - # Create columns - # - - $T column create -text Layout -tags C0 - $T configure -treecolumn C0 - - # - # Create elements - # - - $T element create e1 rect -width 30 -height 30 -fill gray20 - $T element create e2 rect -width 30 -height 30 -fill gray40 \ - -outline blue -outlinewidth 3 - $T element create e3 rect -fill gray60 - $T element create e4 rect -fill [list $::SystemHighlight {selected focus} gray80 {}] \ - -showfocus yes - $T element create e5 rect -fill {"sky blue"} -width 20 -height 20 - $T element create e6 rect -fill {"sea green"} -width 30 -height 16 - $T element create e7 rect -fill {"sky blue"} -width 30 -height 16 - $T element create e8 rect -fill gray70 -height 1 - - # - # Create styles using the elements - # - - set S [$T style create s1] - $T style elements $S {e4 e3 e1 e2 e5 e6 e7} - $T style layout $S e1 -padx {28 4} -pady 4 - $T style layout $S e2 -expand es -padx {0 38} - $T style layout $S e3 -union [list e1 e2] -ipadx 4 -ipady 4 -pady 2 - $T style layout $S e4 -detach yes -iexpand xy - $T style layout $S e5 -detach yes -padx {2 0} -pady 2 -iexpand y - $T style layout $S e6 -detach yes -expand ws -padx {0 2} -pady {2 0} - $T style layout $S e7 -detach yes -expand wn -padx {0 2} -pady {0 2} - - # - # Create items and assign styles - # - - set I [$T item create -button yes] - $T item style set $I C0 $S - $T item lastchild root $I - set parent $I - - set I [$T item create] - $T item style set $I C0 $S - $T item lastchild $parent $I - - ### - - set S [$T style create s2] - $T style elements $S {e4 e3 e1} - $T style layout $S e1 -padx 8 -pady 8 -iexpand x - $T style layout $S e3 -union e1 -ipadx {20 4} -ipady {4 12} - $T style layout $S e4 -detach yes -iexpand xy - - set I [$T item create -button yes] - $T item style set $I C0 $S - $T item lastchild root $I - - set I2 [$T item create] - $T item style set $I2 C0 $S - $T item lastchild $I $I2 - - ### - - set S [$T style create s3] - $T style elements $S {e4 e3 e1 e5 e6} - $T style layout $S e4 -union {e1 e6} -ipadx 8 -ipady {8 0} - $T style layout $S e3 -union {e1 e5} -ipadx 4 -ipady 4 - $T style layout $S e5 -height 40 - - set I [$T item create -button yes] - $T item style set $I C0 $S - $T item lastchild root $I - - set I2 [$T item create] - $T item style set $I2 C0 $S - $T item lastchild $I $I2 - - ### - - $T element create eb border -background $::SystemButtonFace \ - -relief {sunken {selected} raised {}} -thickness 2 -filled yes - $T element create et text - - set text "Here is a text element surrounded by a border element.\nResize the column to watch me wrap." - - set S [$T style create s4] - $T style elements $S {eb et} - $T style layout $S eb -union et -ipadx 2 -ipady 2 - $T style layout $S et -squeeze x - - set I [$T item create -button yes] - $T item style set $I C0 $S - $T item text $I C0 $text - $T item lastchild root $I - set parent $I - - set I [$T item create] - $T item style set $I C0 $S - $T item text $I C0 $text - $T item lastchild $parent $I - - ### - - set styleNum 5 - foreach {orient expandList} {horizontal {s ns n} vertical {e we w}} { - foreach expand $expandList { - - set S [$T style create s$styleNum -orient $orient] - $T style elements $S {e4 e8 e2 e5 e6} - $T style layout $S e4 -detach yes -iexpand xy - $T style layout $S e8 -detach yes -expand n -iexpand x - $T style layout $S e2 -expand $expand - $T style layout $S e5 -expand $expand - $T style layout $S e6 -expand $expand - incr styleNum - - set I [$T item create] - $T item style set $I C0 $S - $T item lastchild root $I - } + set T [DemoList] + + # + # Configure the treectrl widget + # + + $T configure -showroot no -showrootbutton yes -showbuttons yes \ + -showlines $::ShowLines -itemheight 0 -selectmode browse + + # + # Create columns + # + + $T column create -text Layout -tags C0 + $T configure -treecolumn C0 + + # + # Create elements + # + + $T element create e1 rect -width 30 -height 30 -fill gray20 + $T element create e2 rect -width 30 -height 30 -fill gray40 \ + -outline blue -outlinewidth 3 + $T element create e3 rect -fill gray60 + $T element create e4 rect -fill [list $::SystemHighlight {selected focus} gray80 {}] \ + -showfocus yes + $T element create e5 rect -fill {"sky blue"} -width 20 -height 20 + $T element create e6 rect -fill {"sea green"} -width 30 -height 16 + $T element create e7 rect -fill {"sky blue"} -width 30 -height 16 + $T element create e8 rect -fill gray70 -height 1 + + # + # Create styles using the elements + # + + set S [$T style create s1] + $T style elements $S {e4 e3 e1 e2 e5 e6 e7} + $T style layout $S e1 -padx {28 4} -pady 4 + $T style layout $S e2 -expand es -padx {0 38} + $T style layout $S e3 -union [list e1 e2] -ipadx 4 -ipady 4 -pady 2 + $T style layout $S e4 -detach yes -iexpand xy + $T style layout $S e5 -detach yes -padx {2 0} -pady 2 -iexpand y + $T style layout $S e6 -detach yes -expand ws -padx {0 2} -pady {2 0} + $T style layout $S e7 -detach yes -expand wn -padx {0 2} -pady {0 2} + + # + # Create items and assign styles + # + + set I [$T item create -button yes] + $T item style set $I C0 $S + $T item lastchild root $I + set parent $I + + set I [$T item create] + $T item style set $I C0 $S + $T item lastchild $parent $I + + ### + + set S [$T style create s2] + $T style elements $S {e4 e3 e1} + $T style layout $S e1 -padx 8 -pady 8 -iexpand x + $T style layout $S e3 -union e1 -ipadx {20 4} -ipady {4 12} + $T style layout $S e4 -detach yes -iexpand xy + + set I [$T item create -button yes] + $T item style set $I C0 $S + $T item lastchild root $I + + set I2 [$T item create] + $T item style set $I2 C0 $S + $T item lastchild $I $I2 + + ### + + set S [$T style create s3] + $T style elements $S {e4 e3 e1 e5 e6} + $T style layout $S e4 -union {e1 e6} -ipadx 8 -ipady {8 0} + $T style layout $S e3 -union {e1 e5} -ipadx 4 -ipady 4 + $T style layout $S e5 -height 40 + + set I [$T item create -button yes] + $T item style set $I C0 $S + $T item lastchild root $I + + set I2 [$T item create] + $T item style set $I2 C0 $S + $T item lastchild $I $I2 + + ### + + $T element create eb border -background $::SystemButtonFace \ + -relief {sunken {selected} raised {}} -thickness 2 -filled yes + $T element create et text + + set text "Here is a text element surrounded by a border element.\nResize the column to watch me wrap." + + set S [$T style create s4] + $T style elements $S {eb et} + $T style layout $S eb -union et -ipadx 2 -ipady 2 + $T style layout $S et -squeeze x + + set I [$T item create -button yes] + $T item style set $I C0 $S + $T item text $I C0 $text + $T item lastchild root $I + set parent $I + + set I [$T item create] + $T item style set $I C0 $S + $T item text $I C0 $text + $T item lastchild $parent $I + + ### + + set styleNum 5 + foreach {orient expandList} {horizontal {s ns n} vertical {e we w}} { + foreach expand $expandList { + + set S [$T style create s$styleNum -orient $orient] + $T style elements $S {e4 e8 e2 e5 e6} + $T style layout $S e4 -detach yes -iexpand xy + $T style layout $S e8 -detach yes -expand n -iexpand x + $T style layout $S e2 -expand $expand + $T style layout $S e5 -expand $expand + $T style layout $S e6 -expand $expand + incr styleNum + + set I [$T item create] + $T item style set $I C0 $S + $T item lastchild root $I } + } - return + return } diff --git a/demos/mailwasher.tcl b/demos/mailwasher.tcl index d87b506..74d379b 100644 --- a/demos/mailwasher.tcl +++ b/demos/mailwasher.tcl @@ -1,206 +1,206 @@ -# RCS: @(#) $Id: mailwasher.tcl,v 1.16 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: mailwasher.tcl,v 1.17 2006/11/30 02:41:38 treectrl Exp $ # # Demo: MailWasher # proc DemoMailWasher {} { - set T [DemoList] - - InitPics *checked - - set height [font metrics [$T cget -font] -linespace] - if {$height < 18} { - set height 18 - } - - # - # Configure the treectrl widget - # - - $T configure -showroot no -showrootbutton no -showbuttons no \ - -showlines no -itemheight $height -selectmode browse \ - -xscrollincrement 20 - - # - # Create columns - # - - set pad 4 - $T column create -text Delete -textpadx $pad -justify center -tags delete - $T column create -text Bounce -textpadx $pad -justify center -tags bounce - $T column create -text Status -width 80 -textpadx $pad -tags status - $T column create -text Size -width 40 -textpadx $pad -justify right -tags size - $T column create -text From -width 140 -textpadx $pad -tags from - $T column create -text Subject -width 240 -textpadx $pad -tags subject - $T column create -text Received -textpadx $pad -arrow up -tags received - $T column create -text Attachments -textpadx $pad -tags attachments - - $T state define CHECK - - # - # Create elements - # - - $T element create border rect -open nw -outline gray -outlinewidth 1 \ - -fill [list $::SystemHighlight {selected}] - $T element create imgCheck image -image {checked CHECK unchecked {}} - $T element create txtAny text \ - -fill [list $::SystemHighlightText {selected}] -lines 1 - $T element create txtNone text -text "none" \ - -fill [list $::SystemHighlightText {selected}] -lines 1 - $T element create txtYes text -text "yes" \ - -fill [list $::SystemHighlightText {selected}] -lines 1 - $T element create txtNormal text -text "Normal" \ - -fill [list $::SystemHighlightText {selected} #006800 {}] -lines 1 - $T element create txtPossSpam text -text "Possible Spam" \ - -fill [list $::SystemHighlightText {selected} #787800 {}] -lines 1 - $T element create txtProbSpam text -text "Probably Spam" \ - -fill [list $::SystemHighlightText {selected} #FF9000 {}] -lines 1 - $T element create txtBlacklist text -text "Blacklisted" \ - -fill [list $::SystemHighlightText {selected} #FF5800 {}] -lines 1 - - # - # Create styles using the elements - # - - set S [$T style create styCheck] - $T style elements $S [list border imgCheck] + set T [DemoList] + + InitPics *checked + + set height [font metrics [$T cget -font] -linespace] + if {$height < 18} { + set height 18 + } + + # + # Configure the treectrl widget + # + + $T configure -showroot no -showrootbutton no -showbuttons no \ + -showlines no -itemheight $height -selectmode browse \ + -xscrollincrement 20 + + # + # Create columns + # + + set pad 4 + $T column create -text Delete -textpadx $pad -justify center -tags delete + $T column create -text Bounce -textpadx $pad -justify center -tags bounce + $T column create -text Status -width 80 -textpadx $pad -tags status + $T column create -text Size -width 40 -textpadx $pad -justify right -tags size + $T column create -text From -width 140 -textpadx $pad -tags from + $T column create -text Subject -width 240 -textpadx $pad -tags subject + $T column create -text Received -textpadx $pad -arrow up -tags received + $T column create -text Attachments -textpadx $pad -tags attachments + + $T state define CHECK + + # + # Create elements + # + + $T element create border rect -open nw -outline gray -outlinewidth 1 \ + -fill [list $::SystemHighlight {selected}] + $T element create imgCheck image -image {checked CHECK unchecked {}} + $T element create txtAny text \ + -fill [list $::SystemHighlightText {selected}] -lines 1 + $T element create txtNone text -text "none" \ + -fill [list $::SystemHighlightText {selected}] -lines 1 + $T element create txtYes text -text "yes" \ + -fill [list $::SystemHighlightText {selected}] -lines 1 + $T element create txtNormal text -text "Normal" \ + -fill [list $::SystemHighlightText {selected} #006800 {}] -lines 1 + $T element create txtPossSpam text -text "Possible Spam" \ + -fill [list $::SystemHighlightText {selected} #787800 {}] -lines 1 + $T element create txtProbSpam text -text "Probably Spam" \ + -fill [list $::SystemHighlightText {selected} #FF9000 {}] -lines 1 + $T element create txtBlacklist text -text "Blacklisted" \ + -fill [list $::SystemHighlightText {selected} #FF5800 {}] -lines 1 + + # + # Create styles using the elements + # + + set S [$T style create styCheck] + $T style elements $S [list border imgCheck] + $T style layout $S border -detach yes -iexpand xy + $T style layout $S imgCheck -expand news + + set pad 4 + + foreach name {Any None Yes Normal PossSpam ProbSpam Blacklist} { + set S [$T style create sty$name] + $T style elements $S [list border txt$name] $T style layout $S border -detach yes -iexpand xy - $T style layout $S imgCheck -expand news - - set pad 4 - - foreach name {Any None Yes Normal PossSpam ProbSpam Blacklist} { - set S [$T style create sty$name] - $T style elements $S [list border txt$name] - $T style layout $S border -detach yes -iexpand xy - $T style layout $S txt$name -padx $pad -squeeze x -expand ns + $T style layout $S txt$name -padx $pad -squeeze x -expand ns + } + + # + # Create items and assign styles + # + + for {set i 0} {$i < 1} {incr i} { + foreach {from subject} { + baldy@spammer.com "Your hair is thinning" + flat@spammer.com "Your breasts are too small" + tiny@spammer.com "Your penis is too small" + dumbass@spammer.com "You are not very smart" + bankrobber@spammer.com "You need more money" + loser@spammer.com "You need better friends" + gossip@spammer.com "Find out what your coworkers think about you" + whoami@spammer.com "Find out what you think about yourself" + downsized@spammer.com "You need a better job" + poorhouse@spammer.com "Your mortgage is a joke" + spam4ever@spammer.com "You need more spam" + } { + set item [$T item create] + set status [lindex [list styNormal styPossSpam styProbSpam styBlacklist] [expr int(rand() * 4)]] + set delete [expr int(rand() * 2)] + set bounce [expr int(rand() * 2)] + set attachments [lindex [list styNone styYes] [expr int(rand() * 2)]] + $T item style set $item delete styCheck bounce styCheck \ + status $status size styAny \ + from styAny subject styAny received styAny \ + attachments $attachments + if {$delete} { + $T item state forcolumn $item delete CHECK + } + if {$bounce} { + $T item state forcolumn $item bounce CHECK + } + set bytes [expr {512 + int(rand() * 1024 * 12)}] + set size [expr {$bytes / 1024 + 1}]KB + set seconds [expr {[clock seconds] - int(rand() * 100000)}] + set received [clock format $seconds -format "%d/%m/%y %I:%M %p"] + $T item text $item size $size from $from subject $subject received $received + $T item lastchild root $item } - - # - # Create items and assign styles - # - - for {set i 0} {$i < 1} {incr i} { - foreach {from subject} { - baldy@spammer.com "Your hair is thinning" - flat@spammer.com "Your breasts are too small" - tiny@spammer.com "Your penis is too small" - dumbass@spammer.com "You are not very smart" - bankrobber@spammer.com "You need more money" - loser@spammer.com "You need better friends" - gossip@spammer.com "Find out what your coworkers think about you" - whoami@spammer.com "Find out what you think about yourself" - downsized@spammer.com "You need a better job" - poorhouse@spammer.com "Your mortgage is a joke" - spam4ever@spammer.com "You need more spam" - } { - set item [$T item create] - set status [lindex [list styNormal styPossSpam styProbSpam styBlacklist] [expr int(rand() * 4)]] - set delete [expr int(rand() * 2)] - set bounce [expr int(rand() * 2)] - set attachments [lindex [list styNone styYes] [expr int(rand() * 2)]] - $T item style set $item delete styCheck bounce styCheck \ - status $status size styAny \ - from styAny subject styAny received styAny \ - attachments $attachments - if {$delete} { - $T item state forcolumn $item delete CHECK - } - if {$bounce} { - $T item state forcolumn $item bounce CHECK - } - set bytes [expr {512 + int(rand() * 1024 * 12)}] - set size [expr {$bytes / 1024 + 1}]KB - set seconds [expr {[clock seconds] - int(rand() * 100000)}] - set received [clock format $seconds -format "%d/%m/%y %I:%M %p"] - $T item text $item size $size from $from subject $subject received $received - $T item lastchild root $item - } + } + if 0 { + $T notify bind MailWasher { + %T item style set %I %C styOff } - if 0 { - $T notify bind MailWasher { - %T item style set %I %C styOff - } - $T notify bind MailWasher { - %T item style set %I %C styOn - } + $T notify bind MailWasher { + %T item style set %I %C styOn } - - set ::SortColumn received - $T notify bind $T { - if {[%T column compare %C == $SortColumn]} { - if {[%T column cget $SortColumn -arrow] eq "down"} { - set order -increasing - set arrow up - } else { - set order -decreasing - set arrow down - } - } else { - if {[%T column cget $SortColumn -arrow] eq "down"} { - set order -decreasing - set arrow down - } else { - set order -increasing - set arrow up - } - %T column configure $SortColumn -arrow none - set SortColumn %C - } - %T column configure %C -arrow $arrow - switch [%T column cget %C -tags] { - bounce - - delete { - %T item sort root $order -column %C -command [list CompareOnOff %T %C] -column subject -dictionary - } - status { - %T item sort root $order -column %C -dictionary - } - from { - %T item sort root $order -column %C -dictionary -column subject -dictionary - } - subject { - %T item sort root $order -column %C -dictionary - } - size { - %T item sort root $order -column %C -dictionary -column subject -dictionary - } - received { - %T item sort root $order -column %C -dictionary -column subject -dictionary - } - attachments { - %T item sort root $order -column %C -dictionary -column subject -dictionary - } - } + } + + set ::SortColumn received + $T notify bind $T { + if {[%T column compare %C == $SortColumn]} { + if {[%T column cget $SortColumn -arrow] eq "down"} { + set order -increasing + set arrow up + } else { + set order -decreasing + set arrow down + } + } else { + if {[%T column cget $SortColumn -arrow] eq "down"} { + set order -decreasing + set arrow down + } else { + set order -increasing + set arrow up + } + %T column configure $SortColumn -arrow none + set SortColumn %C } - - bind DemoMailWasher { - set id [%W identify %x %y] - if {$id eq ""} { - } elseif {[lindex $id 0] eq "header"} { - } else { - lassign $id what item where arg1 arg2 arg3 - if {$where eq "column"} { - if {[%W column tag expr $arg1 {delete || bounce}]} { - %W item state forcolumn $item $arg1 ~CHECK + %T column configure %C -arrow $arrow + switch [%T column cget %C -tags] { + bounce - + delete { + %T item sort root $order -column %C -command [list CompareOnOff %T %C] -column subject -dictionary + } + status { + %T item sort root $order -column %C -dictionary + } + from { + %T item sort root $order -column %C -dictionary -column subject -dictionary + } + subject { + %T item sort root $order -column %C -dictionary + } + size { + %T item sort root $order -column %C -dictionary -column subject -dictionary + } + received { + %T item sort root $order -column %C -dictionary -column subject -dictionary + } + attachments { + %T item sort root $order -column %C -dictionary -column subject -dictionary + } + } + } + + bind DemoMailWasher { + set id [%W identify %x %y] + if {$id eq ""} { + } elseif {[lindex $id 0] eq "header"} { + } else { + lassign $id what item where arg1 arg2 arg3 + if {$where eq "column"} { + if {[%W column tag expr $arg1 {delete || bounce}]} { + %W item state forcolumn $item $arg1 ~CHECK # return -code break - } - } } + } } + } - bindtags $T [list $T DemoMailWasher TreeCtrl [winfo toplevel $T] all] + bindtags $T [list $T DemoMailWasher TreeCtrl [winfo toplevel $T] all] - return + return } proc CompareOnOff {T C item1 item2} { - set s1 [$T item state forcolumn $item1 $C] - set s2 [$T item state forcolumn $item2 $C] - if {$s1 eq $s2} { return 0 } - if {[lsearch -exact $s1 CHECK] == -1} { return -1 } - return 1 + set s1 [$T item state forcolumn $item1 $C] + set s2 [$T item state forcolumn $item2 $C] + if {$s1 eq $s2} { return 0 } + if {[lsearch -exact $s1 CHECK] == -1} { return -1 } + return 1 } diff --git a/demos/outlook-folders.tcl b/demos/outlook-folders.tcl index 9345715..565ec3f 100644 --- a/demos/outlook-folders.tcl +++ b/demos/outlook-folders.tcl @@ -1,138 +1,138 @@ -# RCS: @(#) $Id: outlook-folders.tcl,v 1.12 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: outlook-folders.tcl,v 1.13 2006/11/30 02:41:38 treectrl Exp $ # # Demo: Outlook Express folder list # proc DemoOutlookFolders {} { - InitPics outlook-* - - set T [DemoList] - - set height [font metrics [$T cget -font] -linespace] - if {$height < 18} { - set height 18 - } - - # - # Configure the treectrl widget - # - - $T configure -itemheight $height -selectmode browse \ - -showroot yes -showrootbutton no -showbuttons yes -showlines $::ShowLines - - # - # Create columns - # - - $T column create -text Folders -tags C0 - $T configure -treecolumn C0 - - # - # Create elements - # - - $T element create elemImgAny image - $T element create elemTxtRead text -fill [list $::SystemHighlightText {selected focus}] \ - -lines 1 - $T element create elemTxtUnread text -fill [list $::SystemHighlightText {selected focus}] \ - -font [list "[$T cget -font] bold"] -lines 1 - $T element create elemTxtCount text -fill blue - $T element create elemImgFolder image -image outlook-folder - $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \ - -showfocus yes - - # - # Create styles using the elements - # - - # image + text - set S [$T style create styAnyRead] - $T style elements $S {elemRectSel elemImgAny elemTxtRead} - $T style layout $S elemImgAny -expand ns - $T style layout $S elemTxtRead -padx {4 0} -expand ns -squeeze x - $T style layout $S elemRectSel -union [list elemTxtRead] -iexpand ns -ipadx 2 - - # image + text + text - set S [$T style create styAnyUnread] - $T style elements $S {elemRectSel elemImgAny elemTxtUnread elemTxtCount} - $T style layout $S elemImgAny -expand ns - $T style layout $S elemTxtUnread -padx 4 -expand ns -squeeze x - $T style layout $S elemTxtCount -expand ns - $T style layout $S elemRectSel -union [list elemTxtUnread] -iexpand ns -ipadx 2 - - # folder + text - set S [$T style create styFolderRead] - $T style elements $S {elemRectSel elemImgFolder elemTxtRead} - $T style layout $S elemImgFolder -expand ns - $T style layout $S elemTxtRead -padx {4 0} -expand ns -squeeze x - $T style layout $S elemRectSel -union [list elemTxtRead] -iexpand ns -ipadx 2 - - # folder + text + text - set S [$T style create styFolderUnread] - $T style elements $S {elemRectSel elemImgFolder elemTxtUnread elemTxtCount} - $T style layout $S elemImgFolder -expand ns - $T style layout $S elemTxtUnread -padx 4 -expand ns -squeeze x - $T style layout $S elemTxtCount -expand ns - $T style layout $S elemRectSel -union [list elemTxtUnread] -iexpand ns -ipadx 2 - - # - # Create items and assign styles - # - - $T item style set root C0 styAnyRead - $T item element configure root C0 \ - elemImgAny -image outlook-main + \ - elemTxtRead -text "Outlook Express" - - set parentList [list root {} {} {} {} {} {}] - set parent root - foreach {depth img text button unread} { - 0 local "Local Folders" yes 0 - 1 inbox Inbox no 5 - 1 outbox Outbox no 0 - 1 sent "Sent Items" no 0 - 1 deleted "Deleted Items" no 50 - 1 draft Drafts no 0 - 1 folder "Messages to Dad" no 0 - 1 folder "Messages to Sis" no 0 - 1 folder "Messages to Me" yes 5 - 2 folder "2001" no 0 - 2 folder "2000" no 0 - 2 folder "1999" no 0 - 0 server "news.gmane.org" yes 0 - 1 group "gmane.comp.lang.lua.general" no 498 - } { - set item [$T item create -button $button] - if {[string equal $img folder]} { - if {$unread} { - $T item style set $item C0 styFolderUnread - $T item element configure $item C0 \ - elemTxtUnread -text $text + \ - elemTxtCount -text "($unread)" - } else { - $T item style set $item C0 styFolderRead - $T item element configure $item C0 elemTxtRead -text $text - } - } else { - if {$unread} { - $T item style set $item C0 styAnyUnread - $T item element configure $item C0 \ - elemImgAny -image outlook-$img + \ - elemTxtUnread -text $text + \ - elemTxtCount -text "($unread)" - } else { - $T item style set $item C0 styAnyRead - $T item element configure $item C0 \ - elemImgAny -image outlook-$img + \ - elemTxtRead -text $text - } - } - $T item lastchild [lindex $parentList $depth] $item - incr depth - set parentList [lreplace $parentList $depth $depth $item] + InitPics outlook-* + + set T [DemoList] + + set height [font metrics [$T cget -font] -linespace] + if {$height < 18} { + set height 18 + } + + # + # Configure the treectrl widget + # + + $T configure -itemheight $height -selectmode browse \ + -showroot yes -showrootbutton no -showbuttons yes -showlines $::ShowLines + + # + # Create columns + # + + $T column create -text Folders -tags C0 + $T configure -treecolumn C0 + + # + # Create elements + # + + $T element create elemImgAny image + $T element create elemTxtRead text -fill [list $::SystemHighlightText {selected focus}] \ + -lines 1 + $T element create elemTxtUnread text -fill [list $::SystemHighlightText {selected focus}] \ + -font [list "[$T cget -font] bold"] -lines 1 + $T element create elemTxtCount text -fill blue + $T element create elemImgFolder image -image outlook-folder + $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] \ + -showfocus yes + + # + # Create styles using the elements + # + + # image + text + set S [$T style create styAnyRead] + $T style elements $S {elemRectSel elemImgAny elemTxtRead} + $T style layout $S elemImgAny -expand ns + $T style layout $S elemTxtRead -padx {4 0} -expand ns -squeeze x + $T style layout $S elemRectSel -union [list elemTxtRead] -iexpand ns -ipadx 2 + + # image + text + text + set S [$T style create styAnyUnread] + $T style elements $S {elemRectSel elemImgAny elemTxtUnread elemTxtCount} + $T style layout $S elemImgAny -expand ns + $T style layout $S elemTxtUnread -padx 4 -expand ns -squeeze x + $T style layout $S elemTxtCount -expand ns + $T style layout $S elemRectSel -union [list elemTxtUnread] -iexpand ns -ipadx 2 + + # folder + text + set S [$T style create styFolderRead] + $T style elements $S {elemRectSel elemImgFolder elemTxtRead} + $T style layout $S elemImgFolder -expand ns + $T style layout $S elemTxtRead -padx {4 0} -expand ns -squeeze x + $T style layout $S elemRectSel -union [list elemTxtRead] -iexpand ns -ipadx 2 + + # folder + text + text + set S [$T style create styFolderUnread] + $T style elements $S {elemRectSel elemImgFolder elemTxtUnread elemTxtCount} + $T style layout $S elemImgFolder -expand ns + $T style layout $S elemTxtUnread -padx 4 -expand ns -squeeze x + $T style layout $S elemTxtCount -expand ns + $T style layout $S elemRectSel -union [list elemTxtUnread] -iexpand ns -ipadx 2 + + # + # Create items and assign styles + # + + $T item style set root C0 styAnyRead + $T item element configure root C0 \ + elemImgAny -image outlook-main + \ + elemTxtRead -text "Outlook Express" + + set parentList [list root {} {} {} {} {} {}] + set parent root + foreach {depth img text button unread} { + 0 local "Local Folders" yes 0 + 1 inbox Inbox no 5 + 1 outbox Outbox no 0 + 1 sent "Sent Items" no 0 + 1 deleted "Deleted Items" no 50 + 1 draft Drafts no 0 + 1 folder "Messages to Dad" no 0 + 1 folder "Messages to Sis" no 0 + 1 folder "Messages to Me" yes 5 + 2 folder "2001" no 0 + 2 folder "2000" no 0 + 2 folder "1999" no 0 + 0 server "news.gmane.org" yes 0 + 1 group "gmane.comp.lang.lua.general" no 498 + } { + set item [$T item create -button $button] + if {[string equal $img folder]} { + if {$unread} { + $T item style set $item C0 styFolderUnread + $T item element configure $item C0 \ + elemTxtUnread -text $text + \ + elemTxtCount -text "($unread)" + } else { + $T item style set $item C0 styFolderRead + $T item element configure $item C0 elemTxtRead -text $text + } + } else { + if {$unread} { + $T item style set $item C0 styAnyUnread + $T item element configure $item C0 \ + elemImgAny -image outlook-$img + \ + elemTxtUnread -text $text + \ + elemTxtCount -text "($unread)" + } else { + $T item style set $item C0 styAnyRead + $T item element configure $item C0 \ + elemImgAny -image outlook-$img + \ + elemTxtRead -text $text + } } + $T item lastchild [lindex $parentList $depth] $item + incr depth + set parentList [lreplace $parentList $depth $depth $item] + } - return + return } diff --git a/demos/outlook-newgroup.tcl b/demos/outlook-newgroup.tcl index 99ff108..8341cf1 100644 --- a/demos/outlook-newgroup.tcl +++ b/demos/outlook-newgroup.tcl @@ -1,422 +1,422 @@ -# RCS: @(#) $Id: outlook-newgroup.tcl,v 1.18 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: outlook-newgroup.tcl,v 1.19 2006/11/30 02:41:39 treectrl Exp $ # # Demo: Outlook Express newsgroup messages # proc DemoOutlookNewsgroup {} { - global Message - - InitPics outlook-* - - set T [DemoList] - - set height [font metrics [$T cget -font] -linespace] - if {$height < 18} { - set height 18 + global Message + + InitPics outlook-* + + set T [DemoList] + + set height [font metrics [$T cget -font] -linespace] + if {$height < 18} { + set height 18 + } + + # + # Configure the treectrl widget + # + + $T configure -itemheight $height -selectmode browse \ + -showroot no -showrootbutton no -showbuttons yes -showlines no \ + -xscrollincrement 20 + + # + # Create columns + # + + $T column create -image outlook-clip -tags clip + $T column create -image outlook-arrow -tags arrow + $T column create -image outlook-watch -tags watch + $T column create -text Subject -width 250 -tags subject + $T column create -text From -width 150 -tags from + $T column create -text Sent -width 150 -tags sent + $T column create -text Size -width 60 -justify right -tags size + + # Would be nice if I could specify a column -tag too + # *blink* The amazing code Genie makes it so!!! + $T configure -treecolumn subject + + # State for a read message + $T state define read + + # State for a message with unread descendants + $T state define unread + + # + # Create elements + # + + $T element create elemImg image -image { + outlook-read-2Sel {selected read unread !open} + outlook-read-2 {read unread !open} + outlook-readSel {selected read} + outlook-read {read} + outlook-unreadSel {selected} + outlook-unread {} + } + $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] \ + -font [list "[$T cget -font] bold" {read unread !open} "[$T cget -font] bold" {!read}] -lines 1 + $T element create sel.e rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open e -showfocus yes + $T element create sel.w rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open w -showfocus yes + $T element create sel.we rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open we -showfocus yes + + # + # Create styles using the elements + # + + # Image + text + set S [$T style create s1] + $T style elements $S {sel.e elemImg elemTxt} + $T style layout $S elemImg -expand ns + $T style layout $S elemTxt -padx {2 6} -squeeze x -expand ns + $T style layout $S sel.e -union [list elemTxt] -iexpand nes -ipadx {2 0} + + # Text + set S [$T style create s2.we] + $T style elements $S {sel.we elemTxt} + $T style layout $S elemTxt -padx 6 -squeeze x -expand ns + $T style layout $S sel.we -detach yes -iexpand xy + + # Text + set S [$T style create s2.w] + $T style elements $S {sel.w elemTxt} + $T style layout $S elemTxt -padx 6 -squeeze x -expand ns + $T style layout $S sel.w -detach yes -iexpand xy + + # Set default item styles + $T column configure subject -itemstyle s1 + $T column configure from -itemstyle s2.we + $T column configure sent -itemstyle s2.we + $T column configure size -itemstyle s2.w + + # + # Create items and assign styles + # + + set msgCnt 100 + + set thread 0 + set Message(count,0) 0 + set items [$T item id root] + for {set i 1} {$i < $msgCnt} {incr i} { + set itemi [$T item create] + while 1 { + set j [expr {int(rand() * $i)}] + set itemj [lindex $items $j] + if {$j == 0} break + if {[$T depth $itemj] == 5} continue + if {$Message(count,$Message(thread,$itemj)) == 15} continue + break } - - # - # Configure the treectrl widget - # - - $T configure -itemheight $height -selectmode browse \ - -showroot no -showrootbutton no -showbuttons yes -showlines no \ - -xscrollincrement 20 - - # - # Create columns - # - - $T column create -image outlook-clip -tags clip - $T column create -image outlook-arrow -tags arrow - $T column create -image outlook-watch -tags watch - $T column create -text Subject -width 250 -tags subject - $T column create -text From -width 150 -tags from - $T column create -text Sent -width 150 -tags sent - $T column create -text Size -width 60 -justify right -tags size - - # Would be nice if I could specify a column -tag too - # *blink* The amazing code Genie makes it so!!! - $T configure -treecolumn subject - - # State for a read message - $T state define read - - # State for a message with unread descendants - $T state define unread - - # - # Create elements - # - - $T element create elemImg image -image { - outlook-read-2Sel {selected read unread !open} - outlook-read-2 {read unread !open} - outlook-readSel {selected read} - outlook-read {read} - outlook-unreadSel {selected} - outlook-unread {} + $T item lastchild $itemj $itemi + + set Message(read,$itemi) [expr rand() * 2 > 1] + if {$j == 0} { + set Message(thread,$itemi) [incr thread] + set Message(seconds,$itemi) [expr {[clock seconds] - int(rand() * 500000)}] + set Message(seconds2,$itemi) $Message(seconds,$itemi) + set Message(count,$thread) 1 + } else { + set Message(thread,$itemi) $Message(thread,$itemj) + set Message(seconds,$itemi) [expr {$Message(seconds2,$itemj) + int(rand() * 10000)}] + set Message(seconds2,$itemi) $Message(seconds,$itemi) + set Message(seconds2,$itemj) $Message(seconds,$itemi) + incr Message(count,$Message(thread,$itemj)) } - $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] \ - -font [list "[$T cget -font] bold" {read unread !open} "[$T cget -font] bold" {!read}] -lines 1 - $T element create sel.e rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open e -showfocus yes - $T element create sel.w rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open w -showfocus yes - $T element create sel.we rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open we -showfocus yes - - # - # Create styles using the elements - # - - # Image + text - set S [$T style create s1] - $T style elements $S {sel.e elemImg elemTxt} - $T style layout $S elemImg -expand ns - $T style layout $S elemTxt -padx {2 6} -squeeze x -expand ns - $T style layout $S sel.e -union [list elemTxt] -iexpand nes -ipadx {2 0} - - # Text - set S [$T style create s2.we] - $T style elements $S {sel.we elemTxt} - $T style layout $S elemTxt -padx 6 -squeeze x -expand ns - $T style layout $S sel.we -detach yes -iexpand xy - - # Text - set S [$T style create s2.w] - $T style elements $S {sel.w elemTxt} - $T style layout $S elemTxt -padx 6 -squeeze x -expand ns - $T style layout $S sel.w -detach yes -iexpand xy - - # Set default item styles - $T column configure subject -itemstyle s1 - $T column configure from -itemstyle s2.we - $T column configure sent -itemstyle s2.we - $T column configure size -itemstyle s2.w - - # - # Create items and assign styles - # - - set msgCnt 100 - - set thread 0 - set Message(count,0) 0 - set items [$T item id root] - for {set i 1} {$i < $msgCnt} {incr i} { - set itemi [$T item create] - while 1 { - set j [expr {int(rand() * $i)}] - set itemj [lindex $items $j] - if {$j == 0} break - if {[$T depth $itemj] == 5} continue - if {$Message(count,$Message(thread,$itemj)) == 15} continue - break - } - $T item lastchild $itemj $itemi - - set Message(read,$itemi) [expr rand() * 2 > 1] - if {$j == 0} { - set Message(thread,$itemi) [incr thread] - set Message(seconds,$itemi) [expr {[clock seconds] - int(rand() * 500000)}] - set Message(seconds2,$itemi) $Message(seconds,$itemi) - set Message(count,$thread) 1 - } else { - set Message(thread,$itemi) $Message(thread,$itemj) - set Message(seconds,$itemi) [expr {$Message(seconds2,$itemj) + int(rand() * 10000)}] - set Message(seconds2,$itemi) $Message(seconds,$itemi) - set Message(seconds2,$itemj) $Message(seconds,$itemi) - incr Message(count,$Message(thread,$itemj)) - } - lappend items $itemi + lappend items $itemi + } + + for {set i 1} {$i < $msgCnt} {incr i} { + set itemi [lindex $items $i] + set subject "This is thread number $Message(thread,$itemi)" + set from somebody@somewhere.net + set sent [clock format $Message(seconds,$itemi) -format "%d/%m/%y %I:%M %p"] + set size [expr {1 + int(rand() * 10)}]KB + + # This message has been read + if {$Message(read,$itemi)} { + $T item state set $itemi read } - for {set i 1} {$i < $msgCnt} {incr i} { - set itemi [lindex $items $i] - set subject "This is thread number $Message(thread,$itemi)" - set from somebody@somewhere.net - set sent [clock format $Message(seconds,$itemi) -format "%d/%m/%y %I:%M %p"] - set size [expr {1 + int(rand() * 10)}]KB - - # This message has been read - if {$Message(read,$itemi)} { - $T item state set $itemi read - } - - # This message has unread descendants - if {[AnyUnreadDescendants $T $itemi]} { - $T item state set $itemi unread - } - - if {[$T item numchildren $itemi]} { - $T item configure $itemi -button yes + # This message has unread descendants + if {[AnyUnreadDescendants $T $itemi]} { + $T item state set $itemi unread + } - # Collapse some messages - if {rand() * 2 > 1} { - $T item collapse $itemi - } - } + if {[$T item numchildren $itemi]} { + $T item configure $itemi -button yes -# $T item style set $i 3 s1 4 s2.we 5 s2.we 6 s2.w - $T item text $itemi subject $subject from $from sent $sent size $size + # Collapse some messages + if {rand() * 2 > 1} { + $T item collapse $itemi + } } - # Do something when the selection changes - $T notify bind $T { - - # One item is selected - if {[%T selection count] == 1} { - if {[info exists Message(afterId)]} { - after cancel $Message(afterId) - } - set Message(afterId,item) [%T selection get 0] - set Message(afterId) [after 500 MessageReadDelayed] - } +# $T item style set $i 3 s1 4 s2.we 5 s2.we 6 s2.w + $T item text $itemi subject $subject from $from sent $sent size $size + } + + # Do something when the selection changes + $T notify bind $T { + + # One item is selected + if {[%T selection count] == 1} { + if {[info exists Message(afterId)]} { + after cancel $Message(afterId) + } + set Message(afterId,item) [%T selection get 0] + set Message(afterId) [after 500 MessageReadDelayed] } + } - return + return } proc MessageReadDelayed {} { - global Message + global Message - set T [DemoList] + set T [DemoList] - unset Message(afterId) - set I $Message(afterId,item) - if {![$T selection includes $I]} return + unset Message(afterId) + set I $Message(afterId,item) + if {![$T selection includes $I]} return - # This message is not read - if {!$Message(read,$I)} { + # This message is not read + if {!$Message(read,$I)} { - # Read the message - $T item state set $I read - set Message(read,$I) 1 + # Read the message + $T item state set $I read + set Message(read,$I) 1 - # Check ancestors (except root) - foreach I2 [lrange [$T item ancestors $I] 0 end-1] { + # Check ancestors (except root) + foreach I2 [lrange [$T item ancestors $I] 0 end-1] { - # This ancestor has no more unread descendants - if {![AnyUnreadDescendants $T $I2]} { - $T item state set $I2 !unread - } - } + # This ancestor has no more unread descendants + if {![AnyUnreadDescendants $T $I2]} { + $T item state set $I2 !unread + } } + } } # Alternate implementation that does not rely on run-time states proc DemoOutlookNewsgroup_2 {} { - global Message - - InitPics outlook-* - - set T [DemoList] - - set height [font metrics [$T cget -font] -linespace] - if {$height < 18} { - set height 18 + global Message + + InitPics outlook-* + + set T [DemoList] + + set height [font metrics [$T cget -font] -linespace] + if {$height < 18} { + set height 18 + } + + # + # Configure the treectrl widget + # + + $T configure -itemheight $height -selectmode browse \ + -showroot no -showrootbutton no -showbuttons yes -showlines no + + # + # Create columns + # + + $T column create -image outlook-clip -tags clip + $T column create -image outlook-arrow -tags arrow + $T column create -image outlook-watch -tags watch + $T column create -text Subject -width 250 -tags subject + $T column create -text From -width 150 -tags from + $T column create -text Sent -width 150 -tags sent + $T column create -text Size -width 60 -justify right -tags size + + $T configure -treecolumn 3 + + # + # Create elements + # + + $T element create image.unread image -image outlook-unread + $T element create image.read image -image outlook-read + $T element create image.read2 image -image outlook-read-2 + $T element create text.read text -fill [list $::SystemHighlightText {selected focus}] \ + -lines 1 + $T element create text.unread text -fill [list $::SystemHighlightText {selected focus}] \ + -font [list "[$T cget -font] bold"] -lines 1 + $T element create sel.e rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open e -showfocus yes + $T element create sel.w rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open w -showfocus yes + $T element create sel.we rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open we -showfocus yes + + # + # Create styles using the elements + # + + # Image + text + set S [$T style create unread] + $T style elements $S {sel.e image.unread text.unread} + $T style layout $S image.unread -expand ns + $T style layout $S text.unread -padx {2 6} -squeeze x -expand ns + $T style layout $S sel.e -union [list text.unread] -iexpand nes -ipadx {2 0} + + # Image + text + set S [$T style create read] + $T style elements $S {sel.e image.read text.read} + $T style layout $S image.read -expand ns + $T style layout $S text.read -padx {2 6} -squeeze x -expand ns + $T style layout $S sel.e -union [list text.read] -iexpand nes -ipadx {2 0} + + # Image + text + set S [$T style create read2] + $T style elements $S {sel.e image.read2 text.unread} + $T style layout $S image.read2 -expand ns + $T style layout $S text.unread -padx {2 6} -squeeze x -expand ns + $T style layout $S sel.e -union [list text.unread] -iexpand nes -ipadx {2 0} + + # Text + set S [$T style create unread.we] + $T style elements $S {sel.we text.unread} + $T style layout $S text.unread -padx 6 -squeeze x -expand ns + $T style layout $S sel.we -detach yes -iexpand xy + + # Text + set S [$T style create read.we] + $T style elements $S {sel.we text.read} + $T style layout $S text.read -padx 6 -squeeze x -expand ns + $T style layout $S sel.we -detach yes -iexpand xy + + # Text + set S [$T style create unread.w] + $T style elements $S {sel.w text.unread} + $T style layout $S text.unread -padx 6 -squeeze x -expand ns + $T style layout $S sel.w -detach yes -iexpand xy + + # Text + set S [$T style create read.w] + $T style elements $S {sel.w text.read} + $T style layout $S text.read -padx 6 -squeeze x -expand ns + $T style layout $S sel.w -detach yes -iexpand xy + + # + # Create items and assign styles + # + + set msgCnt 100 + + set thread 0 + set Message(count,0) 0 + for {set i 1} {$i < $msgCnt} {incr i} { + $T item create + while 1 { + set j [expr {int(rand() * $i)}] + if {$j == 0} break + if {[$T depth $j] == 5} continue + if {$Message(count,$Message(thread,$j)) == 15} continue + break } - - # - # Configure the treectrl widget - # - - $T configure -itemheight $height -selectmode browse \ - -showroot no -showrootbutton no -showbuttons yes -showlines no - - # - # Create columns - # - - $T column create -image outlook-clip -tags clip - $T column create -image outlook-arrow -tags arrow - $T column create -image outlook-watch -tags watch - $T column create -text Subject -width 250 -tags subject - $T column create -text From -width 150 -tags from - $T column create -text Sent -width 150 -tags sent - $T column create -text Size -width 60 -justify right -tags size - - $T configure -treecolumn 3 - - # - # Create elements - # - - $T element create image.unread image -image outlook-unread - $T element create image.read image -image outlook-read - $T element create image.read2 image -image outlook-read-2 - $T element create text.read text -fill [list $::SystemHighlightText {selected focus}] \ - -lines 1 - $T element create text.unread text -fill [list $::SystemHighlightText {selected focus}] \ - -font [list "[$T cget -font] bold"] -lines 1 - $T element create sel.e rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open e -showfocus yes - $T element create sel.w rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open w -showfocus yes - $T element create sel.we rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open we -showfocus yes - - # - # Create styles using the elements - # - - # Image + text - set S [$T style create unread] - $T style elements $S {sel.e image.unread text.unread} - $T style layout $S image.unread -expand ns - $T style layout $S text.unread -padx {2 6} -squeeze x -expand ns - $T style layout $S sel.e -union [list text.unread] -iexpand nes -ipadx {2 0} - - # Image + text - set S [$T style create read] - $T style elements $S {sel.e image.read text.read} - $T style layout $S image.read -expand ns - $T style layout $S text.read -padx {2 6} -squeeze x -expand ns - $T style layout $S sel.e -union [list text.read] -iexpand nes -ipadx {2 0} - - # Image + text - set S [$T style create read2] - $T style elements $S {sel.e image.read2 text.unread} - $T style layout $S image.read2 -expand ns - $T style layout $S text.unread -padx {2 6} -squeeze x -expand ns - $T style layout $S sel.e -union [list text.unread] -iexpand nes -ipadx {2 0} - - # Text - set S [$T style create unread.we] - $T style elements $S {sel.we text.unread} - $T style layout $S text.unread -padx 6 -squeeze x -expand ns - $T style layout $S sel.we -detach yes -iexpand xy - - # Text - set S [$T style create read.we] - $T style elements $S {sel.we text.read} - $T style layout $S text.read -padx 6 -squeeze x -expand ns - $T style layout $S sel.we -detach yes -iexpand xy - - # Text - set S [$T style create unread.w] - $T style elements $S {sel.w text.unread} - $T style layout $S text.unread -padx 6 -squeeze x -expand ns - $T style layout $S sel.w -detach yes -iexpand xy - - # Text - set S [$T style create read.w] - $T style elements $S {sel.w text.read} - $T style layout $S text.read -padx 6 -squeeze x -expand ns - $T style layout $S sel.w -detach yes -iexpand xy - - # - # Create items and assign styles - # - - set msgCnt 100 - - set thread 0 - set Message(count,0) 0 - for {set i 1} {$i < $msgCnt} {incr i} { - $T item create - while 1 { - set j [expr {int(rand() * $i)}] - if {$j == 0} break - if {[$T depth $j] == 5} continue - if {$Message(count,$Message(thread,$j)) == 15} continue - break - } - $T item lastchild $j $i - - set Message(read,$i) [expr rand() * 2 > 1] - if {$j == 0} { - set Message(thread,$i) [incr thread] - set Message(seconds,$i) [expr {[clock seconds] - int(rand() * 500000)}] - set Message(seconds2,$i) $Message(seconds,$i) - set Message(count,$thread) 1 - } else { - set Message(thread,$i) $Message(thread,$j) - set Message(seconds,$i) [expr {$Message(seconds2,$j) + int(rand() * 10000)}] - set Message(seconds2,$i) $Message(seconds,$i) - set Message(seconds2,$j) $Message(seconds,$i) - incr Message(count,$Message(thread,$j)) - } + $T item lastchild $j $i + + set Message(read,$i) [expr rand() * 2 > 1] + if {$j == 0} { + set Message(thread,$i) [incr thread] + set Message(seconds,$i) [expr {[clock seconds] - int(rand() * 500000)}] + set Message(seconds2,$i) $Message(seconds,$i) + set Message(count,$thread) 1 + } else { + set Message(thread,$i) $Message(thread,$j) + set Message(seconds,$i) [expr {$Message(seconds2,$j) + int(rand() * 10000)}] + set Message(seconds2,$i) $Message(seconds,$i) + set Message(seconds2,$j) $Message(seconds,$i) + incr Message(count,$Message(thread,$j)) } - - for {set i 1} {$i < $msgCnt} {incr i} { - set subject "This is thread number $Message(thread,$i)" - set from somebody@somewhere.net - set sent [clock format $Message(seconds,$i) -format "%d/%m/%y %I:%M %p"] - set size [expr {1 + int(rand() * 10)}]KB - if {$Message(read,$i)} { - set style read - set style2 read - } else { - set style unread - set style2 unread - } - $T item style set $i 3 $style 4 $style2.we 5 $style2.we 6 $style2.w - $T item text $i 3 $subject 4 $from 5 $sent 6 $size - if {[$T item numchildren $i]} { - $T item configure $i -button yes - } + } + + for {set i 1} {$i < $msgCnt} {incr i} { + set subject "This is thread number $Message(thread,$i)" + set from somebody@somewhere.net + set sent [clock format $Message(seconds,$i) -format "%d/%m/%y %I:%M %p"] + set size [expr {1 + int(rand() * 10)}]KB + if {$Message(read,$i)} { + set style read + set style2 read + } else { + set style unread + set style2 unread } - - $T notify bind $T { - if {[%T selection count] == 1} { - set I [%T selection get 0] - if {!$Message(read,$I)} { - if {[%T item isopen $I] || ![AnyUnreadDescendants %T $I]} { - # unread ->read - %T item style map $I subject read {text.unread text.read} - %T item style map $I from read.we {text.unread text.read} - %T item style map $I sent read.we {text.unread text.read} - %T item style map $I size read.w {text.unread text.read} - } else { - # unread -> read2 - %T item style map $I subject read2 {text.unread text.unread} - } - set Message(read,$I) 1 - DisplayStylesInItem $I - } - } + $T item style set $i 3 $style 4 $style2.we 5 $style2.we 6 $style2.w + $T item text $i 3 $subject 4 $from 5 $sent 6 $size + if {[$T item numchildren $i]} { + $T item configure $i -button yes } - - $T notify bind $T { - if {$Message(read,%I) && [AnyUnreadDescendants %T %I]} { - # read2 -> read - %T item style map %I subject read {text.unread text.read} - # unread -> read - %T item style map %I from read.we {text.unread text.read} - %T item style map %I sent read.we {text.unread text.read} - %T item style map %I size read.w {text.unread text.read} + } + + $T notify bind $T { + if {[%T selection count] == 1} { + set I [%T selection get 0] + if {!$Message(read,$I)} { + if {[%T item isopen $I] || ![AnyUnreadDescendants %T $I]} { + # unread ->read + %T item style map $I subject read {text.unread text.read} + %T item style map $I from read.we {text.unread text.read} + %T item style map $I sent read.we {text.unread text.read} + %T item style map $I size read.w {text.unread text.read} + } else { + # unread -> read2 + %T item style map $I subject read2 {text.unread text.unread} } + set Message(read,$I) 1 + DisplayStylesInItem $I + } } - - $T notify bind $T { - if {$Message(read,%I) && [AnyUnreadDescendants %T %I]} { - # read -> read2 - %T item style map %I subject read2 {text.read text.unread} - # read -> unread - %T item style map %I from unread.we {text.read text.unread} - %T item style map %I sent unread.we {text.read text.unread} - %T item style map %I size unread.w {text.read text.unread} - } + } + + $T notify bind $T { + if {$Message(read,%I) && [AnyUnreadDescendants %T %I]} { + # read2 -> read + %T item style map %I subject read {text.unread text.read} + # unread -> read + %T item style map %I from read.we {text.unread text.read} + %T item style map %I sent read.we {text.unread text.read} + %T item style map %I size read.w {text.unread text.read} + } + } + + $T notify bind $T { + if {$Message(read,%I) && [AnyUnreadDescendants %T %I]} { + # read -> read2 + %T item style map %I subject read2 {text.read text.unread} + # read -> unread + %T item style map %I from unread.we {text.read text.unread} + %T item style map %I sent unread.we {text.read text.unread} + %T item style map %I size unread.w {text.read text.unread} } + } - for {set i 1} {$i < $msgCnt} {incr i} { - if {rand() * 2 > 1} { - if {[$T item numchildren $i]} { - $T item collapse $i - } - } + for {set i 1} {$i < $msgCnt} {incr i} { + if {rand() * 2 > 1} { + if {[$T item numchildren $i]} { + $T item collapse $i + } } + } - return + return } proc AnyUnreadDescendants {T I} { - global Message + global Message - foreach item [$T item descendants $I] { - if {!$Message(read,$item)} { - return 1 - } + foreach item [$T item descendants $I] { + if {!$Message(read,$item)} { + return 1 } - return 0 + } + return 0 } diff --git a/demos/random.tcl b/demos/random.tcl index 1294e66..0baef52 100644 --- a/demos/random.tcl +++ b/demos/random.tcl @@ -1,4 +1,4 @@ -# RCS: @(#) $Id: random.tcl,v 1.23 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: random.tcl,v 1.24 2006/11/30 02:41:39 treectrl Exp $ set RandomN 500 set RandomDepth 5 @@ -8,389 +8,389 @@ set RandomDepth 5 # proc DemoRandom {} { - set T [DemoList] - - InitPics folder-* small-* - - set height [font metrics [$T cget -font] -linespace] - if {$height < 18} { - set height 18 + set T [DemoList] + + InitPics folder-* small-* + + set height [font metrics [$T cget -font] -linespace] + if {$height < 18} { + set height 18 + } + + # + # Configure the treectrl widget + # + + $T configure -itemheight $height -selectmode extended \ + -showroot yes -showrootbutton yes -showbuttons yes -showlines $::ShowLines \ + -scrollmargin 16 -xscrolldelay "500 50" -yscrolldelay "500 50" + + # + # Create columns + # + + $T column create -expand yes -weight 4 -text Item -itembackground {#e0e8f0 {}} \ + -tags colItem + $T column create -text Parent -justify center -itembackground {gray90 {}} \ + -uniform a -expand yes -tags colParent + $T column create -text Depth -justify center -itembackground {linen {}} \ + -uniform a -expand yes -tags colDepth + + $T configure -treecolumn colItem + + # + # Create elements + # + + $T element create elemImgFolder image -image {folder-open {open} folder-closed {}} + $T element create elemImgFile image -image small-file + $T element create elemTxtName text \ + -fill [list $::SystemHighlightText {selected focus}] + $T element create elemTxtCount text -fill blue + $T element create elemTxtAny text + $T element create elemRectSel rect -showfocus yes \ + -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] + + # + # Create styles using the elements + # + + set S [$T style create styFolder] + $T style elements $S {elemRectSel elemImgFolder elemTxtName elemTxtCount} + $T style layout $S elemImgFolder -padx {0 4} -expand ns + $T style layout $S elemTxtName -padx {0 4} -expand ns + $T style layout $S elemTxtCount -padx {0 6} -expand ns + $T style layout $S elemRectSel -union [list elemTxtName] -iexpand ns -ipadx 2 + + set S [$T style create styFile] + $T style elements $S {elemRectSel elemImgFile elemTxtName} + $T style layout $S elemImgFile -padx {0 4} -expand ns + $T style layout $S elemTxtName -padx {0 4} -expand ns + $T style layout $S elemRectSel -union [list elemTxtName] -iexpand ns -ipadx 2 + + set S [$T style create styAny] + $T style elements $S {elemTxtAny} + $T style layout $S elemTxtAny -padx 6 -expand ns + + TreeCtrl::SetSensitive $T { + {colItem styFolder elemRectSel elemImgFolder elemTxtName} + {colItem styFile elemRectSel elemImgFile elemTxtName} + } + TreeCtrl::SetDragImage $T { + {colItem styFolder elemImgFolder elemTxtName} + {colItem styFile elemImgFile elemTxtName} + } + + # + # Create items and assign styles + # + + set clicks [clock clicks] + set items [$T item create -count [expr {$::RandomN - 1}]] + set added root + foreach itemi $items { + set j [expr {int(rand() * [llength $added])}] + set itemj [lindex $added $j] + if {[$T depth $itemj] < $::RandomDepth - 1} { + lappend added $itemi } - - # - # Configure the treectrl widget - # - - $T configure -itemheight $height -selectmode extended \ - -showroot yes -showrootbutton yes -showbuttons yes -showlines $::ShowLines \ - -scrollmargin 16 -xscrolldelay "500 50" -yscrolldelay "500 50" - - # - # Create columns - # - - $T column create -expand yes -weight 4 -text Item -itembackground {#e0e8f0 {}} \ - -tags colItem - $T column create -text Parent -justify center -itembackground {gray90 {}} \ - -uniform a -expand yes -tags colParent - $T column create -text Depth -justify center -itembackground {linen {}} \ - -uniform a -expand yes -tags colDepth - - $T configure -treecolumn colItem - - # - # Create elements - # - - $T element create elemImgFolder image -image {folder-open {open} folder-closed {}} - $T element create elemImgFile image -image small-file - $T element create elemTxtName text \ - -fill [list $::SystemHighlightText {selected focus}] - $T element create elemTxtCount text -fill blue - $T element create elemTxtAny text - $T element create elemRectSel rect -showfocus yes \ - -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] - - # - # Create styles using the elements - # - - set S [$T style create styFolder] - $T style elements $S {elemRectSel elemImgFolder elemTxtName elemTxtCount} - $T style layout $S elemImgFolder -padx {0 4} -expand ns - $T style layout $S elemTxtName -padx {0 4} -expand ns - $T style layout $S elemTxtCount -padx {0 6} -expand ns - $T style layout $S elemRectSel -union [list elemTxtName] -iexpand ns -ipadx 2 - - set S [$T style create styFile] - $T style elements $S {elemRectSel elemImgFile elemTxtName} - $T style layout $S elemImgFile -padx {0 4} -expand ns - $T style layout $S elemTxtName -padx {0 4} -expand ns - $T style layout $S elemRectSel -union [list elemTxtName] -iexpand ns -ipadx 2 - - set S [$T style create styAny] - $T style elements $S {elemTxtAny} - $T style layout $S elemTxtAny -padx 6 -expand ns - - TreeCtrl::SetSensitive $T { - {colItem styFolder elemRectSel elemImgFolder elemTxtName} - {colItem styFile elemRectSel elemImgFile elemTxtName} + if {![$T item cget $itemj -button]} { + $T item configure $itemj -button yes } - TreeCtrl::SetDragImage $T { - {colItem styFolder elemImgFolder elemTxtName} - {colItem styFile elemImgFile elemTxtName} + if {rand() * 2 > 1} { + $T item collapse $itemi } - - # - # Create items and assign styles - # - - set clicks [clock clicks] - set items [$T item create -count [expr {$::RandomN - 1}]] - set added root - foreach itemi $items { - set j [expr {int(rand() * [llength $added])}] - set itemj [lindex $added $j] - if {[$T depth $itemj] < $::RandomDepth - 1} { - lappend added $itemi - } - if {![$T item cget $itemj -button]} { - $T item configure $itemj -button yes - } - if {rand() * 2 > 1} { - $T item collapse $itemi - } - if {rand() * 2 > 1} { - $T item lastchild $itemj $itemi - } else { - $T item firstchild $itemj $itemi - } - } - puts "created $::RandomN-1 items in [expr [clock clicks] - $clicks] clicks" - - set clicks [clock clicks] - lappend items [$T item id root] - foreach item $items { - set numChildren [$T item numchildren $item] - if {$numChildren} { - $T item style set $item colItem styFolder colParent styAny colDepth styAny - $T item element configure $item \ - colItem elemTxtName -text "Item $item" + elemTxtCount -text "($numChildren)" , \ - colParent elemTxtAny -text "[$T item parent $item]" , \ - colDepth elemTxtAny -text "[$T depth $item]" - } else { - $T item style set $item colItem styFile colParent styAny colDepth styAny - $T item element configure $item \ - colItem elemTxtName -text "Item $item" , \ - colParent elemTxtAny -text "[$T item parent $item]" , \ - colDepth elemTxtAny -text "[$T depth $item]" - } - } - puts "configured $::RandomN items in [expr [clock clicks] - $clicks] clicks" - - bind DemoRandom { - TreeCtrl::DoubleButton1 %W %x %y - break - } - bind DemoRandom { - set TreeCtrl::Priv(selectMode) toggle - RandomButton1 %W %x %y - break - } - bind DemoRandom { - set TreeCtrl::Priv(selectMode) add - RandomButton1 %W %x %y - break - } - bind DemoRandom { - set TreeCtrl::Priv(selectMode) set - RandomButton1 %W %x %y - break - } - bind DemoRandom { - RandomMotion1 %W %x %y - break + if {rand() * 2 > 1} { + $T item lastchild $itemj $itemi + } else { + $T item firstchild $itemj $itemi } - bind DemoRandom { - RandomRelease1 %W %x %y - break + } + puts "created $::RandomN-1 items in [expr [clock clicks] - $clicks] clicks" + + set clicks [clock clicks] + lappend items [$T item id root] + foreach item $items { + set numChildren [$T item numchildren $item] + if {$numChildren} { + $T item style set $item colItem styFolder colParent styAny colDepth styAny + $T item element configure $item \ + colItem elemTxtName -text "Item $item" + elemTxtCount -text "($numChildren)" , \ + colParent elemTxtAny -text "[$T item parent $item]" , \ + colDepth elemTxtAny -text "[$T depth $item]" + } else { + $T item style set $item colItem styFile colParent styAny colDepth styAny + $T item element configure $item \ + colItem elemTxtName -text "Item $item" , \ + colParent elemTxtAny -text "[$T item parent $item]" , \ + colDepth elemTxtAny -text "[$T depth $item]" } - - bindtags $T [list $T DemoRandom TreeCtrl [winfo toplevel $T] all] - - return + } + puts "configured $::RandomN items in [expr [clock clicks] - $clicks] clicks" + + bind DemoRandom { + TreeCtrl::DoubleButton1 %W %x %y + break + } + bind DemoRandom { + set TreeCtrl::Priv(selectMode) toggle + RandomButton1 %W %x %y + break + } + bind DemoRandom { + set TreeCtrl::Priv(selectMode) add + RandomButton1 %W %x %y + break + } + bind DemoRandom { + set TreeCtrl::Priv(selectMode) set + RandomButton1 %W %x %y + break + } + bind DemoRandom { + RandomMotion1 %W %x %y + break + } + bind DemoRandom { + RandomRelease1 %W %x %y + break + } + + bindtags $T [list $T DemoRandom TreeCtrl [winfo toplevel $T] all] + + return } proc RandomButton1 {T x y} { - variable TreeCtrl::Priv - focus $T - set id [$T identify $x $y] - set Priv(buttonMode) "" - - # Click outside any item - if {$id eq ""} { - $T selection clear + variable TreeCtrl::Priv + focus $T + set id [$T identify $x $y] + set Priv(buttonMode) "" + + # Click outside any item + if {$id eq ""} { + $T selection clear + + # Click in header + } elseif {[lindex $id 0] eq "header"} { + TreeCtrl::ButtonPress1 $T $x $y + + # Click in item + } else { + lassign $id where item arg1 arg2 arg3 arg4 + switch $arg1 { + button { + $T item toggle $item + } + line { + $T item toggle $arg2 + } + column { + if {![TreeCtrl::IsSensitive $T $x $y]} { + $T selection clear + return + } - # Click in header - } elseif {[lindex $id 0] eq "header"} { - TreeCtrl::ButtonPress1 $T $x $y + set Priv(drag,motion) 0 + set Priv(drag,click,x) $x + set Priv(drag,click,y) $y + set Priv(drag,x) [$T canvasx $x] + set Priv(drag,y) [$T canvasy $y] + set Priv(drop) "" + + if {$Priv(selectMode) eq "add"} { + TreeCtrl::BeginExtend $T $item + } elseif {$Priv(selectMode) eq "toggle"} { + TreeCtrl::BeginToggle $T $item + } elseif {![$T selection includes $item]} { + TreeCtrl::BeginSelect $T $item + } + $T activate $item - # Click in item - } else { - lassign $id where item arg1 arg2 arg3 arg4 - switch $arg1 { - button { - $T item toggle $item - } - line { - $T item toggle $arg2 - } - column { - if {![TreeCtrl::IsSensitive $T $x $y]} { - $T selection clear - return - } - - set Priv(drag,motion) 0 - set Priv(drag,click,x) $x - set Priv(drag,click,y) $y - set Priv(drag,x) [$T canvasx $x] - set Priv(drag,y) [$T canvasy $y] - set Priv(drop) "" - - if {$Priv(selectMode) eq "add"} { - TreeCtrl::BeginExtend $T $item - } elseif {$Priv(selectMode) eq "toggle"} { - TreeCtrl::BeginToggle $T $item - } elseif {![$T selection includes $item]} { - TreeCtrl::BeginSelect $T $item - } - $T activate $item - - if {[$T selection includes $item]} { - set Priv(buttonMode) drag - } - } + if {[$T selection includes $item]} { + set Priv(buttonMode) drag } + } } - return + } + return } proc RandomMotion1 {T x y} { - variable TreeCtrl::Priv - switch $Priv(buttonMode) { - "drag" { - set Priv(autoscan,command,$T) {RandomMotion %T %x %y} - TreeCtrl::AutoScanCheck $T $x $y - RandomMotion $T $x $y - } - default { - TreeCtrl::Motion1 $T $x $y - } + variable TreeCtrl::Priv + switch $Priv(buttonMode) { + "drag" { + set Priv(autoscan,command,$T) {RandomMotion %T %x %y} + TreeCtrl::AutoScanCheck $T $x $y + RandomMotion $T $x $y } - return + default { + TreeCtrl::Motion1 $T $x $y + } + } + return } proc RandomMotion {T x y} { - variable TreeCtrl::Priv - switch $Priv(buttonMode) { - "drag" { - if {!$Priv(drag,motion)} { - # Detect initial mouse movement - if {(abs($x - $Priv(drag,click,x)) <= 4) && - (abs($y - $Priv(drag,click,y)) <= 4)} return - - set Priv(selection) [$T selection get] - set Priv(drop) "" - $T dragimage clear - # For each selected item, add 2nd and 3rd elements of - # column "item" to the dragimage - foreach I $Priv(selection) { - foreach list $Priv(dragimage,$T) { - set C [lindex $list 0] - set S [lindex $list 1] - if {[$T item style set $I $C] eq $S} { - eval $T dragimage add $I $C [lrange $list 2 end] - } - } - } - set Priv(drag,motion) 1 + variable TreeCtrl::Priv + switch $Priv(buttonMode) { + "drag" { + if {!$Priv(drag,motion)} { + # Detect initial mouse movement + if {(abs($x - $Priv(drag,click,x)) <= 4) && + (abs($y - $Priv(drag,click,y)) <= 4)} return + + set Priv(selection) [$T selection get] + set Priv(drop) "" + $T dragimage clear + # For each selected item, add 2nd and 3rd elements of + # column "item" to the dragimage + foreach I $Priv(selection) { + foreach list $Priv(dragimage,$T) { + set C [lindex $list 0] + set S [lindex $list 1] + if {[$T item style set $I $C] eq $S} { + eval $T dragimage add $I $C [lrange $list 2 end] } - - # Find the item under the cursor - set cursor X_cursor - set drop "" - set id [$T identify $x $y] - if {[TreeCtrl::IsSensitive $T $x $y]} { - set item [lindex $id 1] - # If the item is not in the pre-drag selection - # (i.e. not being dragged) see if we can drop on it - if {[lsearch -exact $Priv(selection) $item] == -1} { - set drop $item - # We can drop if dragged item isn't an ancestor - foreach item2 $Priv(selection) { - if {[$T item isancestor $item2 $item]} { - set drop "" - break - } - } - if {$drop ne ""} { - scan [$T item bbox $drop] "%d %d %d %d" x1 y1 x2 y2 - if {$y < $y1 + 3} { - set cursor top_side - set Priv(drop,pos) prevsibling - } elseif {$y >= $y2 - 3} { - set cursor bottom_side - set Priv(drop,pos) nextsibling - } else { - set cursor "" - set Priv(drop,pos) lastchild - } - } - } + } + } + set Priv(drag,motion) 1 + } + + # Find the item under the cursor + set cursor X_cursor + set drop "" + set id [$T identify $x $y] + if {[TreeCtrl::IsSensitive $T $x $y]} { + set item [lindex $id 1] + # If the item is not in the pre-drag selection + # (i.e. not being dragged) see if we can drop on it + if {[lsearch -exact $Priv(selection) $item] == -1} { + set drop $item + # We can drop if dragged item isn't an ancestor + foreach item2 $Priv(selection) { + if {[$T item isancestor $item2 $item]} { + set drop "" + break } - - if {[$T cget -cursor] ne $cursor} { - $T configure -cursor $cursor + } + if {$drop ne ""} { + scan [$T item bbox $drop] "%d %d %d %d" x1 y1 x2 y2 + if {$y < $y1 + 3} { + set cursor top_side + set Priv(drop,pos) prevsibling + } elseif {$y >= $y2 - 3} { + set cursor bottom_side + set Priv(drop,pos) nextsibling + } else { + set cursor "" + set Priv(drop,pos) lastchild } - - # Select the item under the cursor (if any) and deselect - # the previous drop-item (if any) - $T selection modify $drop $Priv(drop) - set Priv(drop) $drop - - # Show the dragimage in its new position - set x [expr {[$T canvasx $x] - $Priv(drag,x)}] - set y [expr {[$T canvasy $y] - $Priv(drag,y)}] - $T dragimage offset $x $y - $T dragimage configure -visible yes - } - default { - TreeCtrl::Motion1 $T $x $y + } } + } + + if {[$T cget -cursor] ne $cursor} { + $T configure -cursor $cursor + } + + # Select the item under the cursor (if any) and deselect + # the previous drop-item (if any) + $T selection modify $drop $Priv(drop) + set Priv(drop) $drop + + # Show the dragimage in its new position + set x [expr {[$T canvasx $x] - $Priv(drag,x)}] + set y [expr {[$T canvasy $y] - $Priv(drag,y)}] + $T dragimage offset $x $y + $T dragimage configure -visible yes + } + default { + TreeCtrl::Motion1 $T $x $y } - return + } + return } proc RandomRelease1 {T x y} { - variable TreeCtrl::Priv - if {![info exists Priv(buttonMode)]} return - switch $Priv(buttonMode) { - "drag" { - TreeCtrl::AutoScanCancel $T - $T dragimage configure -visible no - $T selection modify {} $Priv(drop) - $T configure -cursor "" - if {$Priv(drop) ne ""} { - RandomDrop $T $Priv(drop) $Priv(selection) $Priv(drop,pos) - } - unset Priv(buttonMode) - } - default { - TreeCtrl::Release1 $T $x $y - } + variable TreeCtrl::Priv +if {![info exists Priv(buttonMode)]} return + switch $Priv(buttonMode) { + "drag" { + TreeCtrl::AutoScanCancel $T + $T dragimage configure -visible no + $T selection modify {} $Priv(drop) + $T configure -cursor "" + if {$Priv(drop) ne ""} { + RandomDrop $T $Priv(drop) $Priv(selection) $Priv(drop,pos) + } + unset Priv(buttonMode) } - return + default { + TreeCtrl::Release1 $T $x $y + } + } + return } proc RandomDrop {T target source pos} { - set parentList {} - switch -- $pos { - lastchild { set parent $target } - prevsibling { set parent [$T item parent $target] } - nextsibling { set parent [$T item parent $target] } + set parentList {} + switch -- $pos { + lastchild { set parent $target } + prevsibling { set parent [$T item parent $target] } + nextsibling { set parent [$T item parent $target] } + } + foreach item $source { + + # Ignore any item whose ancestor is also selected + set ignore 0 + foreach ancestor [$T item ancestors $item] { + if {[lsearch -exact $source $ancestor] != -1} { + set ignore 1 + break + } } - foreach item $source { - - # Ignore any item whose ancestor is also selected - set ignore 0 - foreach ancestor [$T item ancestors $item] { - if {[lsearch -exact $source $ancestor] != -1} { - set ignore 1 - break - } - } - if {$ignore} continue - - # Update the old parent of this moved item later - if {[lsearch -exact $parentList $item] == -1} { - lappend parentList [$T item parent $item] - } + if {$ignore} continue - # Add to target - $T item $pos $target $item + # Update the old parent of this moved item later + if {[lsearch -exact $parentList $item] == -1} { + lappend parentList [$T item parent $item] + } - # Update text: parent - $T item element configure $item colParent elemTxtAny -text $parent + # Add to target + $T item $pos $target $item - # Update text: depth - $T item element configure $item colDepth elemTxtAny -text [$T depth $item] + # Update text: parent + $T item element configure $item colParent elemTxtAny -text $parent - # Recursively update text: depth - foreach item [$T item descendants $item] { - $T item element configure $item colDepth elemTxtAny -text [$T depth $item] - } - } + # Update text: depth + $T item element configure $item colDepth elemTxtAny -text [$T depth $item] - # Update items that lost some children - foreach item $parentList { - set numChildren [$T item numchildren $item] - if {$numChildren == 0} { - $T item configure $item -button no - $T item style map $item colItem styFile {elemTxtName elemTxtName} - } else { - $T item element configure $item colItem elemTxtCount -text "($numChildren)" - } + # Recursively update text: depth + foreach item [$T item descendants $item] { + $T item element configure $item colDepth elemTxtAny -text [$T depth $item] } - - # Update the target that gained some children - if {[$T item style set $parent colItem] ne "styFolder"} { - $T item configure $parent -button yes - $T item style map $parent colItem styFolder {elemTxtName elemTxtName} + } + + # Update items that lost some children + foreach item $parentList { + set numChildren [$T item numchildren $item] + if {$numChildren == 0} { + $T item configure $item -button no + $T item style map $item colItem styFile {elemTxtName elemTxtName} + } else { + $T item element configure $item colItem elemTxtCount -text "($numChildren)" } - set numChildren [$T item numchildren $parent] - $T item element configure $parent colItem elemTxtCount -text "($numChildren)" - return + } + + # Update the target that gained some children + if {[$T item style set $parent colItem] ne "styFolder"} { + $T item configure $parent -button yes + $T item style map $parent colItem styFolder {elemTxtName elemTxtName} + } + set numChildren [$T item numchildren $parent] + $T item element configure $parent colItem elemTxtCount -text "($numChildren)" + return } # @@ -398,15 +398,15 @@ proc RandomDrop {T target source pos} { # proc DemoRandom2 {} { - set T [DemoList] + set T [DemoList] - DemoRandom + DemoRandom - InitPics mac-* + InitPics mac-* - $T configure -buttonimage {mac-collapse open mac-expand {}} \ - -showlines no + $T configure -buttonimage {mac-collapse open mac-expand {}} \ + -showlines no - return + return } diff --git a/demos/textvariable.tcl b/demos/textvariable.tcl index 5f32ed6..9d83a86 100644 --- a/demos/textvariable.tcl +++ b/demos/textvariable.tcl @@ -1,80 +1,80 @@ -# RCS: @(#) $Id: textvariable.tcl,v 1.6 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: textvariable.tcl,v 1.7 2006/11/30 02:41:39 treectrl Exp $ proc DemoTextvariable {} { - set T [DemoList] + set T [DemoList] - # - # Configure the treectrl widget - # + # + # Configure the treectrl widget + # - $T configure -showroot no -showbuttons no -showlines no \ - -selectmode extended -xscrollincrement 20 \ - -yscrollincrement 10 -showheader yes + $T configure -showroot no -showbuttons no -showlines no \ + -selectmode extended -xscrollincrement 20 \ + -yscrollincrement 10 -showheader yes if {!$::clip} { - # Hide the borders because child windows appear on top of them - $T configure -borderwidth 0 -highlightthickness 0 + # Hide the borders because child windows appear on top of them + $T configure -borderwidth 0 -highlightthickness 0 } - # - # Create columns - # + # + # Create columns + # - $T column create -text "Resize Me!" -justify center -tags C0 - $T configure -treecolumn C0 + $T column create -text "Resize Me!" -justify center -tags C0 + $T configure -treecolumn C0 - # - # Create elements - # + # + # Create elements + # - $T element create eWindow window - $T element create eRect rect - $T element create eText1 text -width 300 - $T element create eText2 text -wrap none + $T element create eWindow window + $T element create eRect rect + $T element create eText1 text -width 300 + $T element create eText2 text -wrap none - # - # Create styles using the elements - # + # + # Create styles using the elements + # - set S [$T style create s1 -orient horizontal] - $T style elements $S eText1 - $T style layout $S eText1 -padx 10 -pady 6 -squeeze x + set S [$T style create s1 -orient horizontal] + $T style elements $S eText1 + $T style layout $S eText1 -padx 10 -pady 6 -squeeze x - set S [$T style create s2 -orient vertical] - $T style elements $S {eRect eText2 eWindow} - $T style layout $S eRect -union {eText2 eWindow} -ipadx 8 -ipady 8 -padx 4 -pady {0 4} - $T style layout $S eText2 -pady {0 6} -squeeze x - $T style layout $S eWindow -iexpand x -squeeze x + set S [$T style create s2 -orient vertical] + $T style elements $S {eRect eText2 eWindow} + $T style layout $S eRect -union {eText2 eWindow} -ipadx 8 -ipady 8 -padx 4 -pady {0 4} + $T style layout $S eText2 -pady {0 6} -squeeze x + $T style layout $S eWindow -iexpand x -squeeze x - # - # Create items and assign styles - # + # + # Create items and assign styles + # - set I [$T item create] - $T item style set $I C0 s1 - $T item element configure $I C0 eText1 -text "Each text element and entry widget share the same -textvariable. Editing the text in the entry automatically updates the text element." - $T item lastchild root $I + set I [$T item create] + $T item style set $I C0 s1 + $T item element configure $I C0 eText1 -text "Each text element and entry widget share the same -textvariable. Editing the text in the entry automatically updates the text element." + $T item lastchild root $I - foreach i {0 1} color {gray75 "light blue"} { - set I [$T item create] - $T item style set $I C0 s2 + foreach i {0 1} color {gray75 "light blue"} { + set I [$T item create] + $T item style set $I C0 s2 if {$::clip} { - set clip [frame $T.clip$I -borderwidth 0] - set e [$::entryCmd $clip.e -width 48 -textvariable tvar$I] - $T item element configure $I C0 \ - eRect -fill [list $color] + \ - eText2 -textvariable tvar$I + \ - eWindow -window $clip -clip yes + set clip [frame $T.clip$I -borderwidth 0] + set e [$::entryCmd $clip.e -width 48 -textvariable tvar$I] + $T item element configure $I C0 \ + eRect -fill [list $color] + \ + eText2 -textvariable tvar$I + \ + eWindow -window $clip -clip yes } else { - set e [$::entryCmd $T.e$I -width 48 -textvariable tvar$I] - $T item element configure $I C0 \ - eRect -fill [list $color] + \ - eText2 -textvariable tvar$I + \ - eWindow -window $e + set e [$::entryCmd $T.e$I -width 48 -textvariable tvar$I] + $T item element configure $I C0 \ + eRect -fill [list $color] + \ + eText2 -textvariable tvar$I + \ + eWindow -window $e } - $T item lastchild root $I - set ::tvar$I "This is item $I" - } + $T item lastchild root $I + set ::tvar$I "This is item $I" + } - return + return } diff --git a/demos/www-options.tcl b/demos/www-options.tcl index c4eec66..bf2548d 100644 --- a/demos/www-options.tcl +++ b/demos/www-options.tcl @@ -1,295 +1,295 @@ -# RCS: @(#) $Id: www-options.tcl,v 1.13 2006/11/23 22:24:56 treectrl Exp $ +# RCS: @(#) $Id: www-options.tcl,v 1.14 2006/11/30 02:41:39 treectrl Exp $ proc DemoInternetOptions {} { - global Options - - set T [DemoList] - - set height [font metrics [$T cget -font] -linespace] - if {$height < 18} { - set height 18 - } - - # - # Configure the treectrl widget - # - - $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ - -selectmode browse - - InitPics internet-* - - # - # Create columns - # - - $T column create -text "Internet Options" -tags C0 - - $T configure -treecolumn C0 - - # - # Create elements - # - - $T state define check - $T state define radio - $T state define on - - $T element create elemImg image -image { - internet-check-on {check on} - internet-check-off {check} - internet-radio-on {radio on} - internet-radio-off {radio} - } - $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] - $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus}] -showfocus yes - - # - # Create styles using the elements - # - - set S [$T style create STYLE] - $T style elements $S {elemRectSel elemImg elemTxt} - $T style layout $S elemImg -padx {0 4} -expand ns - $T style layout $S elemTxt -expand ns - $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 - - # - # Create items and assign styles - # - - set parentList [list root {} {} {} {} {} {}] - set parent root - foreach {depth setting text option group} { - 0 print "Printing" "" "" - 1 off "Print background colors and images" "o1" "" - 0 search "Search from Address bar" "" "" - 1 search "When searching" "" "" - 2 off "Display results, and go to the most likely sites" "o2" "r1" - 2 off "Do not search from the Address bar" "o3" "r1" - 2 off "Just display the results in the main window" "o4" "r1" - 2 on "Just go to the most likely site" "o5" "r1" - 0 security "Security" "" "" - 1 on "Check for publisher's certificate revocation" "o5" "" - 1 off "Check for server certificate revocation (requires restart)" "o6" "" - } { - set item [$T item create] - $T item style set $item C0 STYLE - $T item element configure $item C0 elemTxt -text $text - set Options(option,$item) $option - set Options(group,$item) $group - if {($setting eq "on") || ($setting eq "off")} { - set Options(setting,$item) $setting - if {$group eq ""} { - $T item state set $item check - if {$setting eq "on"} { - $T item state set $item on - } - } else { - if {$setting eq "on"} { - set Options(current,$group) $item - $T item state set $item on - } - $T item state set $item radio - } - } else { - $T item element configure $item C0 elemImg -image internet-$setting + global Options + + set T [DemoList] + + set height [font metrics [$T cget -font] -linespace] + if {$height < 18} { + set height 18 + } + + # + # Configure the treectrl widget + # + + $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ + -selectmode browse + + InitPics internet-* + + # + # Create columns + # + + $T column create -text "Internet Options" -tags C0 + + $T configure -treecolumn C0 + + # + # Create elements + # + + $T state define check + $T state define radio + $T state define on + + $T element create elemImg image -image { + internet-check-on {check on} + internet-check-off {check} + internet-radio-on {radio on} + internet-radio-off {radio} + } + $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] + $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus}] -showfocus yes + + # + # Create styles using the elements + # + + set S [$T style create STYLE] + $T style elements $S {elemRectSel elemImg elemTxt} + $T style layout $S elemImg -padx {0 4} -expand ns + $T style layout $S elemTxt -expand ns + $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 + + # + # Create items and assign styles + # + + set parentList [list root {} {} {} {} {} {}] + set parent root + foreach {depth setting text option group} { + 0 print "Printing" "" "" + 1 off "Print background colors and images" "o1" "" + 0 search "Search from Address bar" "" "" + 1 search "When searching" "" "" + 2 off "Display results, and go to the most likely sites" "o2" "r1" + 2 off "Do not search from the Address bar" "o3" "r1" + 2 off "Just display the results in the main window" "o4" "r1" + 2 on "Just go to the most likely site" "o5" "r1" + 0 security "Security" "" "" + 1 on "Check for publisher's certificate revocation" "o5" "" + 1 off "Check for server certificate revocation (requires restart)" "o6" "" + } { + set item [$T item create] + $T item style set $item C0 STYLE + $T item element configure $item C0 elemTxt -text $text + set Options(option,$item) $option + set Options(group,$item) $group + if {($setting eq "on") || ($setting eq "off")} { + set Options(setting,$item) $setting + if {$group eq ""} { + $T item state set $item check + if {$setting eq "on"} { + $T item state set $item on } - $T item lastchild [lindex $parentList $depth] $item - incr depth - set parentList [lreplace $parentList $depth $depth $item] - } - - bind DemoInternetOptions { - TreeCtrl::DoubleButton1 %W %x %y - } - bind DemoInternetOptions { - OptionButton1 %W %x %y - break + } else { + if {$setting eq "on"} { + set Options(current,$group) $item + $T item state set $item on + } + $T item state set $item radio + } + } else { + $T item element configure $item C0 elemImg -image internet-$setting } - - bindtags $T [list $T DemoInternetOptions TreeCtrl [winfo toplevel $T] all] - - return + $T item lastchild [lindex $parentList $depth] $item + incr depth + set parentList [lreplace $parentList $depth $depth $item] + } + + bind DemoInternetOptions { + TreeCtrl::DoubleButton1 %W %x %y + } + bind DemoInternetOptions { + OptionButton1 %W %x %y + break + } + + bindtags $T [list $T DemoInternetOptions TreeCtrl [winfo toplevel $T] all] + + return } proc OptionButton1 {T x y} { - variable TreeCtrl::Priv - global Options - focus $T - set id [$T identify $x $y] - if {[lindex $id 0] eq "header"} { - TreeCtrl::ButtonPress1 $T $x $y - } elseif {$id eq ""} { - set Priv(buttonMode) "" + variable TreeCtrl::Priv + global Options + focus $T + set id [$T identify $x $y] + if {[lindex $id 0] eq "header"} { + TreeCtrl::ButtonPress1 $T $x $y + } elseif {$id eq ""} { + set Priv(buttonMode) "" + } else { + set Priv(buttonMode) "" + set item [lindex $id 1] + $T selection modify $item all + $T activate $item + if {$Options(option,$item) eq ""} return + set group $Options(group,$item) + # a checkbutton + if {$group eq ""} { + $T item state set $item ~on + if {$Options(setting,$item) eq "on"} { + set setting off + } else { + set setting on + } + set Options(setting,$item) $setting + # a radiobutton } else { - set Priv(buttonMode) "" - set item [lindex $id 1] - $T selection modify $item all - $T activate $item - if {$Options(option,$item) eq ""} return - set group $Options(group,$item) - # a checkbutton - if {$group eq ""} { - $T item state set $item ~on - if {$Options(setting,$item) eq "on"} { - set setting off - } else { - set setting on - } - set Options(setting,$item) $setting - # a radiobutton - } else { - set current $Options(current,$group) - if {$current eq $item} return - $T item state set $current !on - $T item state set $item on - set Options(setting,$item) on - set Options(current,$group) $item - } + set current $Options(current,$group) + if {$current eq $item} return + $T item state set $current !on + $T item state set $item on + set Options(setting,$item) on + set Options(current,$group) $item } - return + } + return } # Alternate implementation that does not rely on run-time states proc DemoInternetOptions_2 {} { - global Options - - set T [DemoList] - - set height [font metrics [$T cget -font] -linespace] - if {$height < 18} { - set height 18 - } - - # - # Configure the treectrl widget - # - - $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ - -selectmode browse - - InitPics internet-* - - # - # Create columns - # - - $T column create -text "Internet Options" - - # - # Create elements - # - - $T element create elemImg image - $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] - $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus}] -showfocus yes - - # - # Create styles using the elements - # - - set S [$T style create STYLE] - $T style elements $S {elemRectSel elemImg elemTxt} - $T style layout $S elemImg -padx {0 4} -expand ns - $T style layout $S elemTxt -expand ns - $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 - - # - # Create items and assign styles - # - - set parentList [list root {} {} {} {} {} {}] - set parent root - foreach {depth setting text option group} { - 0 print "Printing" "" "" - 1 off "Print background colors and images" "o1" "" - 0 search "Search from Address bar" "" "" - 1 search "When searching" "" "" - 2 off "Display results, and go to the most likely sites" "o2" "r1" - 2 off "Do not search from the Address bar" "o3" "r1" - 2 off "Just display the results in the main window" "o4" "r1" - 2 on "Just go to the most likely site" "o5" "r1" - 0 security "Security" "" "" - 1 on "Check for publisher's certificate revocation" "o5" "" - 1 off "Check for server certificate revocation (requires restart)" "o6" "" - } { - set item [$T item create] - $T item style set $item 0 STYLE - $T item element configure $item 0 elemTxt -text $text - set Options(option,$item) $option - set Options(group,$item) $group - if {$setting eq "on" || $setting eq "off"} { - set Options(setting,$item) $setting - if {$group eq ""} { - set img internet-check-$setting - $T item element configure $item 0 elemImg -image $img - } else { - if {$setting eq "on"} { - set Options(current,$group) $item - } - set img internet-radio-$setting - $T item element configure $item 0 elemImg -image $img - } - } else { - $T item element configure $item 0 elemImg -image internet-$setting + global Options + + set T [DemoList] + + set height [font metrics [$T cget -font] -linespace] + if {$height < 18} { + set height 18 + } + + # + # Configure the treectrl widget + # + + $T configure -showroot no -showbuttons no -showlines no -itemheight $height \ + -selectmode browse + + InitPics internet-* + + # + # Create columns + # + + $T column create -text "Internet Options" + + # + # Create elements + # + + $T element create elemImg image + $T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] + $T element create elemRectSel rect -fill [list $::SystemHighlight {selected focus}] -showfocus yes + + # + # Create styles using the elements + # + + set S [$T style create STYLE] + $T style elements $S {elemRectSel elemImg elemTxt} + $T style layout $S elemImg -padx {0 4} -expand ns + $T style layout $S elemTxt -expand ns + $T style layout $S elemRectSel -union [list elemTxt] -iexpand ns -ipadx 2 + + # + # Create items and assign styles + # + + set parentList [list root {} {} {} {} {} {}] + set parent root + foreach {depth setting text option group} { + 0 print "Printing" "" "" + 1 off "Print background colors and images" "o1" "" + 0 search "Search from Address bar" "" "" + 1 search "When searching" "" "" + 2 off "Display results, and go to the most likely sites" "o2" "r1" + 2 off "Do not search from the Address bar" "o3" "r1" + 2 off "Just display the results in the main window" "o4" "r1" + 2 on "Just go to the most likely site" "o5" "r1" + 0 security "Security" "" "" + 1 on "Check for publisher's certificate revocation" "o5" "" + 1 off "Check for server certificate revocation (requires restart)" "o6" "" + } { + set item [$T item create] + $T item style set $item 0 STYLE + $T item element configure $item 0 elemTxt -text $text + set Options(option,$item) $option + set Options(group,$item) $group + if {$setting eq "on" || $setting eq "off"} { + set Options(setting,$item) $setting + if {$group eq ""} { + set img internet-check-$setting + $T item element configure $item 0 elemImg -image $img + } else { + if {$setting eq "on"} { + set Options(current,$group) $item } - $T item lastchild [lindex $parentList $depth] $item - incr depth - set parentList [lreplace $parentList $depth $depth $item] - } - - bind DemoInternetOptions { - TreeCtrl::DoubleButton1 %W %x %y - } - bind DemoInternetOptions { - OptionButton1 %W %x %y - break + set img internet-radio-$setting + $T item element configure $item 0 elemImg -image $img + } + } else { + $T item element configure $item 0 elemImg -image internet-$setting } - - bindtags $T [list $T DemoInternetOptions TreeCtrl [winfo toplevel $T] all] - - return + $T item lastchild [lindex $parentList $depth] $item + incr depth + set parentList [lreplace $parentList $depth $depth $item] + } + + bind DemoInternetOptions { + TreeCtrl::DoubleButton1 %W %x %y + } + bind DemoInternetOptions { + OptionButton1 %W %x %y + break + } + + bindtags $T [list $T DemoInternetOptions TreeCtrl [winfo toplevel $T] all] + + return } proc OptionButton1_2 {T x y} { - variable TreeCtrl::Priv - global Options - focus $T - set id [$T identify $x $y] - if {[lindex $id 0] eq "header"} { - TreeCtrl::ButtonPress1 $T $x $y - } elseif {$id eq ""} { - set Priv(buttonMode) "" + variable TreeCtrl::Priv + global Options + focus $T + set id [$T identify $x $y] + if {[lindex $id 0] eq "header"} { + TreeCtrl::ButtonPress1 $T $x $y + } elseif {$id eq ""} { + set Priv(buttonMode) "" + } else { + set Priv(buttonMode) "" + set item [lindex $id 1] + $T selection modify $item all + $T activate $item + if {$Options(option,$item) eq ""} return + set group $Options(group,$item) + # a checkbutton + if {$group eq ""} { + if {$Options(setting,$item) eq "on"} { + set setting off + } else { + set setting on + } + $T item element configure $item 0 elemImg -image internet-check-$setting + set Options(setting,$item) $setting + # a radiobutton } else { - set Priv(buttonMode) "" - set item [lindex $id 1] - $T selection modify $item all - $T activate $item - if {$Options(option,$item) eq ""} return - set group $Options(group,$item) - # a checkbutton - if {$group eq ""} { - if {$Options(setting,$item) eq "on"} { - set setting off - } else { - set setting on - } - $T item element configure $item 0 elemImg -image internet-check-$setting - set Options(setting,$item) $setting - # a radiobutton - } else { - set current $Options(current,$group) - if {$current eq $item} return - $T item element configure $current 0 elemImg -image internet-radio-off - $T item element configure $item 0 elemImg -image internet-radio-on - set Options(setting,$item) on - set Options(current,$group) $item - } + set current $Options(current,$group) + if {$current eq $item} return + $T item element configure $current 0 elemImg -image internet-radio-off + $T item element configure $item 0 elemImg -image internet-radio-on + set Options(setting,$item) on + set Options(current,$group) $item } - return + } + return } -- cgit v0.12