diff options
Diffstat (limited to 'demos/demo.tcl')
-rw-r--r-- | demos/demo.tcl | 205 |
1 files changed, 125 insertions, 80 deletions
diff --git a/demos/demo.tcl b/demos/demo.tcl index d8b1e4f..df0b05a 100644 --- a/demos/demo.tcl +++ b/demos/demo.tcl @@ -1,4 +1,4 @@ -#!../TclTk-8.4.9/bin/wish84.exe +#!/bin/wish84.exe set VERSION 1.2 @@ -115,10 +115,13 @@ foreach list [info loaded] { } puts "demo.tcl: TREECTRL_LIBRARY=$env(TREECTRL_LIBRARY)" +option add *TreeCtrl.UseTheme 1 + # Demo sources foreach file { bitmaps explorer + firefox help imovie layout @@ -471,6 +474,12 @@ proc TreePlusScrollbarsInAFrame {f h v} { if {$v} { grid configure $f.sv -row 0 -column 1 -sticky ns } + + MakeListPopup $f.t + MakeHeaderPopup $f.t + bind $f.t <ButtonPress-3> { + ShowPopup %W %x %y %X %Y + } return } @@ -546,7 +555,7 @@ proc MakeMainWindow {} { # # The application programmer can define custom events to be # generated by the "notify generate" command. The following events - # are generated by the example bindings. + # are generated by the library scripts. .f2.f1.t notify install <Header-invoke> @@ -560,8 +569,8 @@ proc MakeMainWindow {} { return } -proc MakeListPopup {} { - set m [menu .f2.f1.t.mTree -tearoff no] +proc MakeListPopup {T} { + set m [menu $T.mTree -tearoff no] set m2 [menu $m.mCollapse -tearoff no] $m add cascade -label Collapse -menu $m2 @@ -571,168 +580,194 @@ proc MakeListPopup {} { set m2 [menu $m.mBgImg -tearoff no] $m2 add radiobutton -label none -variable Popup(bgimg) -value none \ - -command {.f2.f1.t configure -backgroundimage ""} + -command {$Popup(T) configure -backgroundimage ""} $m2 add radiobutton -label sky -variable Popup(bgimg) -value sky \ - -command {.f2.f1.t configure -backgroundimage $Popup(bgimg)} + -command {$Popup(T) configure -backgroundimage $Popup(bgimg)} $m add cascade -label "Background Image" -menu $m2 set m2 [menu $m.mBgMode -tearoff no] foreach value {column index row visindex} { $m2 add radiobutton -label $value -variable Popup(bgmode) -value $value \ - -command {.f2.f1.t configure -backgroundmode $Popup(bgmode)} + -command {$Popup(T) configure -backgroundmode $Popup(bgmode)} } $m add cascade -label "Background Mode" -menu $m2 + set m2 [menu $m.mVisible -tearoff no] + $m add cascade -label Columns -menu $m2 + set m2 [menu $m.mDebug -tearoff no] $m2 add checkbutton -label Data -variable Popup(debug,data) \ - -command {.f2.f1.t debug configure -data $Popup(debug,data)} + -command {$Popup(T) debug configure -data $Popup(debug,data)} $m2 add checkbutton -label Display -variable Popup(debug,display) \ - -command {.f2.f1.t debug configure -display $Popup(debug,display)} + -command {$Popup(T) debug configure -display $Popup(debug,display)} $m2 add checkbutton -label Enable -variable Popup(debug,enable) \ - -command {.f2.f1.t debug configure -enable $Popup(debug,enable)} + -command {$Popup(T) debug configure -enable $Popup(debug,enable)} $m add cascade -label Debug -menu $m2 set m2 [menu $m.mBuffer -tearoff no] $m2 add radiobutton -label "none" -variable Popup(doublebuffer) -value none \ - -command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)} + -command {$Popup(T) configure -doublebuffer $Popup(doublebuffer)} $m2 add radiobutton -label "item" -variable Popup(doublebuffer) -value item \ - -command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)} + -command {$Popup(T) configure -doublebuffer $Popup(doublebuffer)} $m2 add radiobutton -label "window" -variable Popup(doublebuffer) -value window \ - -command {.f2.f1.t configure -doublebuffer $Popup(doublebuffer)} + -command {$Popup(T) configure -doublebuffer $Popup(doublebuffer)} $m add cascade -label Buffering -menu $m2 set m2 [menu $m.mLineStyle -tearoff no] $m2 add radiobutton -label "dot" -variable Popup(linestyle) -value dot \ - -command {.f2.f1.t configure -linestyle $Popup(linestyle)} + -command {$Popup(T) configure -linestyle $Popup(linestyle)} $m2 add radiobutton -label "solid" -variable Popup(linestyle) -value solid \ - -command {.f2.f1.t configure -linestyle $Popup(linestyle)} + -command {$Popup(T) configure -linestyle $Popup(linestyle)} $m add cascade -label "Line style" -menu $m2 set m2 [menu $m.mOrient -tearoff no] $m2 add radiobutton -label "Horizontal" -variable Popup(orient) -value horizontal \ - -command {.f2.f1.t configure -orient $Popup(orient)} + -command {$Popup(T) configure -orient $Popup(orient)} $m2 add radiobutton -label "Vertical" -variable Popup(orient) -value vertical \ - -command {.f2.f1.t configure -orient $Popup(orient)} + -command {$Popup(T) configure -orient $Popup(orient)} $m add cascade -label Orient -menu $m2 set m2 [menu $m.mSelectMode -tearoff no] foreach mode [list browse extended multiple single] { $m2 add radiobutton -label $mode -variable Popup(selectmode) -value $mode \ - -command {.f2.f1.t configure -selectmode $Popup(selectmode)} + -command {$Popup(T) configure -selectmode $Popup(selectmode)} } $m add cascade -label Selectmode -menu $m2 set m2 [menu $m.mShow -tearoff no] $m2 add checkbutton -label "Buttons" -variable Popup(showbuttons) \ - -command {.f2.f1.t configure -showbuttons $Popup(showbuttons)} + -command {$Popup(T) configure -showbuttons $Popup(showbuttons)} $m2 add checkbutton -label "Header" -variable Popup(showheader) \ - -command {.f2.f1.t configure -showheader $Popup(showheader)} + -command {$Popup(T) configure -showheader $Popup(showheader)} $m2 add checkbutton -label "Lines" -variable Popup(showlines) \ - -command {.f2.f1.t configure -showlines $Popup(showlines)} + -command {$Popup(T) configure -showlines $Popup(showlines)} $m2 add checkbutton -label "Root Lines" -variable Popup(showrootlines) \ - -command {.f2.f1.t configure -showrootlines $Popup(showrootlines)} + -command {$Popup(T) configure -showrootlines $Popup(showrootlines)} $m2 add checkbutton -label "Root" -variable Popup(showroot) \ - -command {.f2.f1.t configure -showroot $Popup(showroot)} + -command {$Popup(T) configure -showroot $Popup(showroot)} $m2 add checkbutton -label "Root Button" -variable Popup(showrootbutton) \ - -command {.f2.f1.t configure -showrootbutton $Popup(showrootbutton)} + -command {$Popup(T) configure -showrootbutton $Popup(showrootbutton)} $m add cascade -label Show -menu $m2 - set m2 [menu $m.mVisible -tearoff no] - $m add cascade -label Visible -menu $m2 + $m add checkbutton -label "Use Theme" -variable Popup(usetheme) \ + -command {$Popup(T) configure -usetheme $Popup(usetheme)} + return } -proc MakeHeaderPopup {} { - set m [menu .f2.f1.t.mHeader -tearoff no] +proc MakeHeaderPopup {T} { + set m [menu $T.mHeader -tearoff no] set m2 [menu $m.mArrow -tearoff no] $m add cascade -label Arrow -menu $m2 - $m2 add radiobutton -label "None" -variable Popup(arrow) -value none -command {.f2.f1.t column configure $Popup(column) -arrow none} - $m2 add radiobutton -label "Up" -variable Popup(arrow) -value up -command {.f2.f1.t column configure $Popup(column) -arrow up} - $m2 add radiobutton -label "Down" -variable Popup(arrow) -value down -command {.f2.f1.t column configure $Popup(column) -arrow down} + $m2 add radiobutton -label "None" -variable Popup(arrow) -value none \ + -command {$Popup(T) column configure $Popup(column) -arrow none} + $m2 add radiobutton -label "Up" -variable Popup(arrow) -value up \ + -command {$Popup(T) column configure $Popup(column) -arrow up} + $m2 add radiobutton -label "Down" -variable Popup(arrow) -value down \ + -command {$Popup(T) column configure $Popup(column) -arrow down} $m2 add separator - $m2 add radiobutton -label "Side Left" -variable Popup(arrow,side) -value left -command {.f2.f1.t column configure $Popup(column) -arrowside left} - $m2 add radiobutton -label "Side Right" -variable Popup(arrow,side) -value right -command {.f2.f1.t column configure $Popup(column) -arrowside right} + $m2 add radiobutton -label "Side Left" -variable Popup(arrow,side) -value left \ + -command {$Popup(T) column configure $Popup(column) -arrowside left} + $m2 add radiobutton -label "Side Right" -variable Popup(arrow,side) -value right \ + -command {$Popup(T) column configure $Popup(column) -arrowside right} $m2 add separator - $m2 add radiobutton -label "Gravity Left" -variable Popup(arrow,gravity) -value left -command {.f2.f1.t column configure $Popup(column) -arrowgravity left} - $m2 add radiobutton -label "Gravity Right" -variable Popup(arrow,gravity) -value right -command {.f2.f1.t column configure $Popup(column) -arrowgravity right} + $m2 add radiobutton -label "Gravity Left" -variable Popup(arrow,gravity) -value left \ + -command {$Popup(T) column configure $Popup(column) -arrowgravity left} + $m2 add radiobutton -label "Gravity Right" -variable Popup(arrow,gravity) -value right \ + -command {$Popup(T) column configure $Popup(column) -arrowgravity right} - $m add checkbutton -label "Expand" -variable Popup(expand) -command {.f2.f1.t column configure $Popup(column) -expand $Popup(expand)} - $m add checkbutton -label "Squeeze" -variable Popup(squeeze) -command {.f2.f1.t column configure $Popup(column) -squeeze $Popup(squeeze)} + $m add checkbutton -label "Button" -variable Popup(button) \ + -command {$Popup(T) column configure $Popup(column) -button $Popup(button)} + $m add checkbutton -label "Expand" -variable Popup(expand) \ + -command {$Popup(T) column configure $Popup(column) -expand $Popup(expand)} set m2 [menu $m.mJustify -tearoff no] $m add cascade -label Justify -menu $m2 - $m2 add radiobutton -label "Left" -variable Popup(justify) -value left -command {.f2.f1.t column configure $Popup(column) -justify left} - $m2 add radiobutton -label "Center" -variable Popup(justify) -value center -command {.f2.f1.t column configure $Popup(column) -justify center} - $m2 add radiobutton -label "Right" -variable Popup(justify) -value right -command {.f2.f1.t column configure $Popup(column) -justify right} + $m2 add radiobutton -label "Left" -variable Popup(justify) -value left \ + -command {$Popup(T) column configure $Popup(column) -justify left} + $m2 add radiobutton -label "Center" -variable Popup(justify) -value center \ + -command {$Popup(T) column configure $Popup(column) -justify center} + $m2 add radiobutton -label "Right" -variable Popup(justify) -value right \ + -command {$Popup(T) column configure $Popup(column) -justify right} + + $m add checkbutton -label "Squeeze" -variable Popup(squeeze) \ + -command {$Popup(T) column configure $Popup(column) -squeeze $Popup(squeeze)} + $m add checkbutton -label "Tree Column" -variable Popup(treecolumn) \ + -command {$Popup(T) configure -treecolumn $Popup(column)} return } MakeMainWindow -MakeListPopup -MakeHeaderPopup InitPics sky -bind .f2.f1.t <ButtonPress-3> { - set id [%W identify %x %y] +proc ShowPopup {T x y X Y} { + global Popup + set Popup(T) $T + set id [$T identify $x $y] if {$id ne ""} { if {[lindex $id 0] eq "header"} { set Popup(column) [lindex $id 1] - set Popup(arrow) [%W column cget $Popup(column) -arrow] - set Popup(arrow,side) [%W column cget $Popup(column) -arrowside] - set Popup(arrow,gravity) [%W column cget $Popup(column) -arrowgravity] - set Popup(expand) [%W column cget $Popup(column) -expand] - set Popup(squeeze) [%W column cget $Popup(column) -squeeze] - set Popup(justify) [%W column cget $Popup(column) -justify] - tk_popup %W.mHeader %X %Y + set Popup(arrow) [$T column cget $Popup(column) -arrow] + set Popup(arrow,side) [$T column cget $Popup(column) -arrowside] + set Popup(arrow,gravity) [$T column cget $Popup(column) -arrowgravity] + set Popup(button) [$T column cget $Popup(column) -button] + set Popup(expand) [$T column cget $Popup(column) -expand] + set Popup(squeeze) [$T column cget $Popup(column) -squeeze] + set Popup(justify) [$T column cget $Popup(column) -justify] + set Popup(treecolumn) [expr {[$T cget -treecolumn] == $Popup(column)}] + tk_popup $T.mHeader $X $Y return } } - set m %W.mTree.mCollapse + set menu $T.mTree + set m $menu.mCollapse $m delete 0 end - $m add command -label "All" -command {%W item collapse all} + $m add command -label "All" -command {$Popup(T) item collapse all} if {$id ne ""} { if {[lindex $id 0] eq "item"} { set item [lindex $id 1] - $m add command -label "Item $item" -command "%W item collapse $item" - $m add command -label "Item $item (recurse)" -command "%W item collapse $item -recurse" + $m add command -label "Item $item" -command "$T item collapse $item" + $m add command -label "Item $item (recurse)" -command "$T item collapse $item -recurse" } } - set m %W.mTree.mExpand + set m $menu.mExpand $m delete 0 end - $m add command -label "All" -command {%W item expand all} + $m add command -label "All" -command {$Popup(T) item expand all} if {$id ne ""} { if {[lindex $id 0] eq "item"} { set item [lindex $id 1] - $m add command -label "Item $item" -command "%W item expand $item" - $m add command -label "Item $item (recurse)" -command "%W item expand $item -recurse" + $m add command -label "Item $item" -command "$T item expand $item" + $m add command -label "Item $item (recurse)" -command "$T item expand $item -recurse" } } foreach option {data display enable} { - set Popup(debug,$option) [%W debug cget -$option] + set Popup(debug,$option) [$T debug cget -$option] } - set Popup(bgimg) [%W cget -backgroundimage] + set Popup(bgimg) [$T cget -backgroundimage] if {$Popup(bgimg) eq ""} { set Popup(bgimg) none } - set Popup(bgmode) [%W cget -backgroundmode] - set Popup(doublebuffer) [%W cget -doublebuffer] - set Popup(linestyle) [%W cget -linestyle] - set Popup(orient) [%W cget -orient] - set Popup(selectmode) [%W cget -selectmode] - set Popup(showbuttons) [%W cget -showbuttons] - set Popup(showheader) [%W cget -showheader] - set Popup(showlines) [%W cget -showlines] - set Popup(showrootlines) [%W cget -showrootlines] - set Popup(showroot) [%W cget -showroot] - set Popup(showrootbutton) [%W cget -showrootbutton] - set m %W.mTree.mVisible + set Popup(bgmode) [$T cget -backgroundmode] + set Popup(doublebuffer) [$T cget -doublebuffer] + set Popup(linestyle) [$T cget -linestyle] + set Popup(orient) [$T cget -orient] + set Popup(selectmode) [$T cget -selectmode] + set Popup(showbuttons) [$T cget -showbuttons] + set Popup(showheader) [$T cget -showheader] + set Popup(showlines) [$T cget -showlines] + set Popup(showrootlines) [$T cget -showrootlines] + set Popup(showroot) [$T cget -showroot] + set Popup(showrootbutton) [$T cget -showrootbutton] + set m $menu.mVisible $m delete 0 end - for {set i 0} {$i < [%W numcolumns]} {incr i} { - set Popup(visible,$i) [%W column cget $i -visible] - $m add checkbutton -label "Column $i \"[%W column cget $i -text]\" \[[%W column cget $i -image]\]" -variable Popup(visible,$i) \ - -command "%W column configure $i -visible \$Popup(visible,$i)" + for {set i 0} {$i < [$T numcolumns]} {incr i} { + set Popup(visible,$i) [$T column cget $i -visible] + $m add checkbutton -label "Column $i \"[$T column cget $i -text]\" \[[$T column cget $i -image]\]" -variable Popup(visible,$i) \ + -command "$T column configure $i -visible \$Popup(visible,$i)" } - tk_popup %W.mTree %X %Y + set Popup(usetheme) [$T cget -usetheme] + tk_popup $menu $X $Y + return } # Allow "scan" bindings @@ -776,6 +811,7 @@ proc InitDemoList {} { "MailWasher" DemoMailWasher mailwasher.tcl \ "Bitmaps" DemoBitmaps bitmaps.tcl \ "iMovie" DemoIMovie imovie.tcl \ + "Firefox Privacy" DemoFirefoxPrivacy firefox.tcl \ ] { set item [$t item create] $t item lastchild root $item @@ -1015,6 +1051,12 @@ proc DemoClear {} { # Delete all elements in demo list eval $T element delete [$T element names] + # Delete -window windows + foreach child [winfo children $T] { + if {[string equal $child $T.mTree] || [string equal $child $T.mHeader]} continue + destroy $child + } + $T item configure root -button no $T item expand root @@ -1022,9 +1064,12 @@ proc DemoClear {} { $T configure -orient vertical -wrap "" -xscrollincrement 0 \ -yscrollincrement 0 -itemheight 0 -showheader yes \ -background white -scrollmargin 0 -xscrolldelay 50 -yscrolldelay 50 \ - -openbuttonimage "" -closedbuttonimage "" -backgroundmode row \ + -buttonbitmap "" -buttonimage "" -backgroundmode row \ -treecolumn 0 -indent 19 -defaultstyle {} -backgroundimage "" \ - -showrootlines yes + -showrootlines yes -minitemheight 0 -borderwidth 6 \ + -highlightthickness 3 + + $T columndrag configure -enable yes # Restore default bindings to the demo list bindtags $T [list $T TreeCtrl [winfo toplevel $T] all] |