diff options
| -rw-r--r-- | library/treectrl.tcl | 656 |
1 files changed, 328 insertions, 328 deletions
diff --git a/library/treectrl.tcl b/library/treectrl.tcl index 2eee3d6..8d4b7a9 100644 --- a/library/treectrl.tcl +++ b/library/treectrl.tcl @@ -6,11 +6,11 @@ bind TreeCtrl <Leave> { } bind TreeCtrl <ButtonPress-1> { - TreeCtrl::ButtonPress1 %W %x %y + TreeCtrl::ButtonPress1 %W %x %y } bind TreeCtrl <Double-ButtonPress-1> { - TreeCtrl::DoubleButton1 %W %x %y + TreeCtrl::DoubleButton1 %W %x %y } bind TreeCtrl <Button1-Motion> { @@ -20,15 +20,15 @@ bind TreeCtrl <ButtonRelease-1> { TreeCtrl::Release1 %W %x %y } bind TreeCtrl <Shift-ButtonPress-1> { - set TreeCtrl::Priv(buttonMode) normal + set TreeCtrl::Priv(buttonMode) normal TreeCtrl::BeginExtend %W [%W index {nearest %x %y}] } bind TreeCtrl <Control-ButtonPress-1> { - set TreeCtrl::Priv(buttonMode) normal + set TreeCtrl::Priv(buttonMode) normal TreeCtrl::BeginToggle %W [%W index {nearest %x %y}] } bind TreeCtrl <Button1-Leave> { - TreeCtrl::Leave1 %W %x %y + TreeCtrl::Leave1 %W %x %y } bind TreeCtrl <Button1-Enter> {} @@ -129,13 +129,13 @@ bind TreeCtrl <Control-KeyPress-backslash> { } bind TreeCtrl <KeyPress-plus> { - %W expand [%W index active] + %W expand [%W index active] } bind TreeCtrl <KeyPress-minus> { - %W collapse [%W index active] + %W collapse [%W index active] } bind TreeCtrl <KeyPress-Return> { - %W toggle [%W index active] + %W toggle [%W index active] } @@ -149,12 +149,12 @@ bind TreeCtrl <Button2-Motion> { } if {$tcl_platform(platform) eq "windows"} { - bind TreeCtrl <Control-ButtonPress-3> { - TreeCtrl::ScanMark %W %x %y - } - bind TreeCtrl <Control-Button3-Motion> { - TreeCtrl::ScanDrag %W %x %y - } + bind TreeCtrl <Control-ButtonPress-3> { + TreeCtrl::ScanMark %W %x %y + } + bind TreeCtrl <Control-Button3-Motion> { + TreeCtrl::ScanDrag %W %x %y + } } # The MouseWheel will typically only fire on Windows. However, @@ -183,276 +183,276 @@ if {[string equal "unix" $tcl_platform(platform)]} { } namespace eval ::TreeCtrl { - variable Priv - array set Priv { - prev {} - rnc {} - } + variable Priv + array set Priv { + prev {} + rnc {} + } } proc ::TreeCtrl::CursorCheck {w x y} { - variable Priv - set id [$w identify $x $y] - if {([llength $id] == 3) && ([lindex $id 0] eq "header")} { - set column [lindex $id 1] - set side [lindex $id 2] - set visCount 0 - for {set i 0} {$i < [$w numcolumns]} {incr i} { - if {[$w column cget $i -visible]} { - lappend visColumns $i - if {$i eq $column} { - set columnIndex $visCount - } - incr visCount - } - } - lappend visColumns tail - if {$column eq "tail"} { - set columnIndex $visCount - } - if {$side eq "left"} { - if {$column eq [lindex $visColumns 0]} { - return - } - set column [lindex $visColumns [expr {$columnIndex - 1}]] - } - if {![info exists Priv(cursor,$w)]} { - set Priv(cursor,$w) [$w cget -cursor] - $w configure -cursor sb_h_double_arrow - if {[info exists Priv(cursor,afterId,$w)]} { - after cancel $Priv(cursor,afterId,$w) - } - set Priv(cursor,afterId,$w) [after 150 [list TreeCtrl::CursorCheckAux $w]] + variable Priv + set id [$w identify $x $y] + if {([llength $id] == 3) && ([lindex $id 0] eq "header")} { + set column [lindex $id 1] + set side [lindex $id 2] + set visCount 0 + for {set i 0} {$i < [$w numcolumns]} {incr i} { + if {[$w column cget $i -visible]} { + lappend visColumns $i + if {$i eq $column} { + set columnIndex $visCount } + incr visCount + } + } + lappend visColumns tail + if {$column eq "tail"} { + set columnIndex $visCount + } + if {$side eq "left"} { + if {$column eq [lindex $visColumns 0]} { return + } + set column [lindex $visColumns [expr {$columnIndex - 1}]] + } + if {![info exists Priv(cursor,$w)]} { + set Priv(cursor,$w) [$w cget -cursor] + $w configure -cursor sb_h_double_arrow + if {[info exists Priv(cursor,afterId,$w)]} { + after cancel $Priv(cursor,afterId,$w) + } + set Priv(cursor,afterId,$w) [after 150 [list TreeCtrl::CursorCheckAux $w]] } - CursorCancel $w return + } + CursorCancel $w + return } proc ::TreeCtrl::CursorCheckAux {w} { - variable Priv - set x [winfo pointerx $w] - set y [winfo pointery $w] - if {[info exists Priv(cursor,$w)]} { - set x [expr {$x - [winfo rootx $w]}] - set y [expr {$y - [winfo rooty $w]}] - CursorCheck $w $x $y - } - return + variable Priv + set x [winfo pointerx $w] + set y [winfo pointery $w] + if {[info exists Priv(cursor,$w)]} { + set x [expr {$x - [winfo rootx $w]}] + set y [expr {$y - [winfo rooty $w]}] + CursorCheck $w $x $y + } + return } proc ::TreeCtrl::CursorCancel {w} { - variable Priv - if {[info exists Priv(cursor,$w)]} { - $w configure -cursor $Priv(cursor,$w) - unset Priv(cursor,$w) - } - if {[info exists Priv(cursor,afterId,$w)]} { - after cancel $Priv(cursor,afterId,$w) - unset Priv(cursor,afterId,$w) - } - return + variable Priv + if {[info exists Priv(cursor,$w)]} { + $w configure -cursor $Priv(cursor,$w) + unset Priv(cursor,$w) + } + if {[info exists Priv(cursor,afterId,$w)]} { + after cancel $Priv(cursor,afterId,$w) + unset Priv(cursor,afterId,$w) + } + return } proc ::TreeCtrl::ButtonPress1 {w x y} { - variable Priv - focus $w - set id [$w identify $x $y] - if {$id eq ""} { - return + variable Priv + focus $w + set id [$w identify $x $y] + if {$id eq ""} { + return + } + if {[lindex $id 0] eq "item"} { + foreach {where item arg1 arg2} $id {} + if {$arg1 eq "button"} { + $w toggle $item + return + } elseif {$arg1 eq "line"} { + $w toggle $arg2 + return } - if {[lindex $id 0] eq "item"} { - foreach {where item arg1 arg2} $id {} - if {$arg1 eq "button"} { - $w toggle $item - return - } elseif {$arg1 eq "line"} { - $w toggle $arg2 - return + } + set Priv(buttonMode) "" + if {[lindex $id 0] eq "header"} { + set column [lindex $id 1] + set visCount 0 + for {set i 0} {$i < [$w numcolumns]} {incr i} { + if {[$w column cget $i -visible]} { + lappend visColumns $i + if {$i eq $column} { + set columnIndex $visCount } + incr visCount + } } - set Priv(buttonMode) "" - if {[lindex $id 0] eq "header"} { - set column [lindex $id 1] - set visCount 0 - for {set i 0} {$i < [$w numcolumns]} {incr i} { - if {[$w column cget $i -visible]} { - lappend visColumns $i - if {$i eq $column} { - set columnIndex $visCount - } - incr visCount - } - } - lappend visColumns tail - if {$column eq "tail"} { - set columnIndex $visCount - } - if {[llength $id] == 3} { - set side [lindex $id 2] - if {$side == "left"} { - if {$column eq [lindex $visColumns 0]} { - return - } - set column [lindex $visColumns [expr {$columnIndex - 1}]] - } - set Priv(buttonMode) resize - set Priv(column) $column - set Priv(x) $x - set Priv(y) $y - set Priv(width) [$w column width $column] - return - } - if {$column eq "tail"} return - if {![$w column cget $column -button]} return - set Priv(buttonMode) header - set Priv(column) $column - $w column configure $column -sunken yes - return + lappend visColumns tail + if {$column eq "tail"} { + set columnIndex $visCount } - set Priv(buttonMode) normal - BeginSelect $w [lindex $id 1] + if {[llength $id] == 3} { + set side [lindex $id 2] + if {$side == "left"} { + if {$column eq [lindex $visColumns 0]} { + return + } + set column [lindex $visColumns [expr {$columnIndex - 1}]] + } + set Priv(buttonMode) resize + set Priv(column) $column + set Priv(x) $x + set Priv(y) $y + set Priv(width) [$w column width $column] + return + } + if {$column eq "tail"} return + if {![$w column cget $column -button]} return + set Priv(buttonMode) header + set Priv(column) $column + $w column configure $column -sunken yes return + } + set Priv(buttonMode) normal + BeginSelect $w [lindex $id 1] + return } # Double-click between columns to set default column width proc ::TreeCtrl::DoubleButton1 {w x y} { - set id [$w identify $x $y] - if {$id eq ""} { - return + set id [$w identify $x $y] + if {$id eq ""} { + return + } + if {[lindex $id 0] eq "item"} { + foreach {where item arg1 arg2} $id {} + if {$arg1 eq "button"} { + $w toggle $item + return + } elseif {$arg1 eq "line"} { + $w toggle $arg2 + return } - if {[lindex $id 0] eq "item"} { - foreach {where item arg1 arg2} $id {} - if {$arg1 eq "button"} { - $w toggle $item - return - } elseif {$arg1 eq "line"} { - $w toggle $arg2 - return + } + if {[lindex $id 0] eq "header"} { + set column [lindex $id 1] + set visCount 0 + for {set i 0} {$i < [$w numcolumns]} {incr i} { + if {[$w column cget $i -visible]} { + lappend visColumns $i + if {$i eq $column} { + set columnIndex $visCount } + incr visCount + } } - if {[lindex $id 0] eq "header"} { - set column [lindex $id 1] - set visCount 0 - for {set i 0} {$i < [$w numcolumns]} {incr i} { - if {[$w column cget $i -visible]} { - lappend visColumns $i - if {$i eq $column} { - set columnIndex $visCount - } - incr visCount - } - } - lappend visColumns tail - if {$column eq "tail"} { - set columnIndex $visCount - } - if {[llength $id] == 3} { - set side [lindex $id 2] - if {$side == "left"} { - if {$column eq [lindex $visColumns 0]} { - return - } - set column [lindex $visColumns [expr {$columnIndex - 1}]] - } - if {$column eq "tail"} return - $w column configure $column -width "" + lappend visColumns tail + if {$column eq "tail"} { + set columnIndex $visCount + } + if {[llength $id] == 3} { + set side [lindex $id 2] + if {$side == "left"} { + if {$column eq [lindex $visColumns 0]} { + return } + set column [lindex $visColumns [expr {$columnIndex - 1}]] + } + if {$column eq "tail"} return + $w column configure $column -width "" } - return + } + return } proc ::TreeCtrl::Motion1 {w x y} { - variable Priv - if {![info exists Priv(buttonMode)]} return - switch $Priv(buttonMode) { - header { - set id [$w identify $x $y] - if {![string match "header $Priv(column)*" $id]} { - if {[$w column cget $Priv(column) -sunken]} { - $w column configure $Priv(column) -sunken no - } - } else { - if {![$w column cget $Priv(column) -sunken]} { - $w column configure $Priv(column) -sunken yes - } - } - } - normal { - set Priv(x) $x - set Priv(y) $y - Motion $w [$w index [list nearest $x $y]] - AutoScanCheck $w $x $y + variable Priv + if {![info exists Priv(buttonMode)]} return + switch $Priv(buttonMode) { + header { + set id [$w identify $x $y] + if {![string match "header $Priv(column)*" $id]} { + if {[$w column cget $Priv(column) -sunken]} { + $w column configure $Priv(column) -sunken no } - resize { - set width [expr {$Priv(width) + $x - $Priv(x)}] - set minWidth [$w column cget $Priv(column) -minwidth] - if {$minWidth eq ""} { - set minWidth 0 - } - if {$width < $minWidth} { - set width $minWidth - } - if {$width == 0} { - incr width - } - scan [$w column bbox $Priv(column)] "%d %d %d %d" x1 y1 x2 y2 - # Use "ne" because -columnproxy could be "" - if {($x1 + $width - 1) ne [$w cget -columnproxy]} { - $w configure -columnproxy [expr {$x1 + $width - 1}] - } + } else { + if {![$w column cget $Priv(column) -sunken]} { + $w column configure $Priv(column) -sunken yes } + } } - return + normal { + set Priv(x) $x + set Priv(y) $y + Motion $w [$w index [list nearest $x $y]] + AutoScanCheck $w $x $y + } + resize { + set width [expr {$Priv(width) + $x - $Priv(x)}] + set minWidth [$w column cget $Priv(column) -minwidth] + if {$minWidth eq ""} { + set minWidth 0 + } + if {$width < $minWidth} { + set width $minWidth + } + if {$width == 0} { + incr width + } + scan [$w column bbox $Priv(column)] "%d %d %d %d" x1 y1 x2 y2 + # Use "ne" because -columnproxy could be "" + if {($x1 + $width - 1) ne [$w cget -columnproxy]} { + $w configure -columnproxy [expr {$x1 + $width - 1}] + } + } + } + return } proc ::TreeCtrl::Leave1 {w x y} { - variable Priv - if {![info exists Priv(buttonMode)]} return - switch $Priv(buttonMode) { - header { - if {[$w column cget $Priv(column) -sunken]} { - $w column configure $Priv(column) -sunken no - } - } - normal { - } - resize {} + variable Priv + if {![info exists Priv(buttonMode)]} return + switch $Priv(buttonMode) { + header { + if {[$w column cget $Priv(column) -sunken]} { + $w column configure $Priv(column) -sunken no + } } - return + normal { + } + resize {} + } + return } proc ::TreeCtrl::Release1 {w x y} { - variable Priv - if {![info exists Priv(buttonMode)]} return - switch $Priv(buttonMode) { - header { - if {[$w column cget $Priv(column) -sunken]} { - $w column configure $Priv(column) -sunken no - # Don't generate the event if it wasn't installed - if {[lsearch -exact [$w notify eventnames] Header] != -1} { - $w notify generate <Header-invoke> [list T $w \ - C $Priv(column)] - } - } - } - normal { - AutoScanCancel $w - $w activate [$w index [list nearest $x $y]] - } - resize { - if {[$w cget -columnproxy] ne ""} { - scan [$w column bbox $Priv(column)] "%d %d %d %d" x1 y1 x2 y2 - set width [expr {[$w cget -columnproxy] - $x1 + 1}] - $w configure -columnproxy {} - $w column configure $Priv(column) -width $width - CursorCheck $w $x $y - } + variable Priv + if {![info exists Priv(buttonMode)]} return + switch $Priv(buttonMode) { + header { + if {[$w column cget $Priv(column) -sunken]} { + $w column configure $Priv(column) -sunken no + # Don't generate the event if it wasn't installed + if {[lsearch -exact [$w notify eventnames] Header] != -1} { + $w notify generate <Header-invoke> [list T $w \ + C $Priv(column)] } + } } - unset Priv(buttonMode) - return + normal { + AutoScanCancel $w + $w activate [$w index [list nearest $x $y]] + } + resize { + if {[$w cget -columnproxy] ne ""} { + scan [$w column bbox $Priv(column)] "%d %d %d %d" x1 y1 x2 y2 + set width [expr {[$w cget -columnproxy] - $x1 + 1}] + $w configure -columnproxy {} + $w column configure $Priv(column) -width $width + CursorCheck $w $x $y + } + } + } + unset Priv(buttonMode) + return } # ::TreeCtrl::BeginSelect -- @@ -587,74 +587,74 @@ proc ::TreeCtrl::BeginToggle {w el} { } proc ::TreeCtrl::CancelRepeat {} { - variable Priv - if {[info exists Priv(afterId)]} { - after cancel $Priv(afterId) - unset Priv(afterId) - } + variable Priv + if {[info exists Priv(afterId)]} { + after cancel $Priv(afterId) + unset Priv(afterId) + } } proc ::TreeCtrl::AutoScanCheck {w x y} { - variable Priv - scan [$w contentbox] "%d %d %d %d" x1 y1 x2 y2 - set margin [winfo pixels $w [$w cget -scrollmargin]] - if {($x < $x1 + $margin) || ($x >= $x2 - $margin) || - ($y < $y1 + $margin) || ($y >= $y2 - $margin)} { - if {![info exists Priv(autoscan,afterId,$w)]} { - if {$y >= $y2 - $margin} { - $w yview scroll 1 units - set delay [$w cget -yscrolldelay] - } elseif {$y < $y1 + $margin} { - $w yview scroll -1 units - set delay [$w cget -yscrolldelay] - } elseif {$x >= $x2 - $margin} { - $w xview scroll 1 units - set delay [$w cget -xscrolldelay] - } elseif {$x < $x1 + $margin} { - $w xview scroll -1 units - set delay [$w cget -xscrolldelay] - } - set count [scan $delay "%d %d" d1 d2] - if {[info exists Priv(autoscan,scanning,$w)]} { - if {$count == 2} { - set delay $d2 - } - } else { - if {$count == 2} { - set delay $d1 - } - set Priv(autoscan,scanning,$w) 1 - } - Motion $w [$w index "nearest $x $y"] - set Priv(autoscan,afterId,$w) [after $delay [list TreeCtrl::AutoScanCheckAux $w]] + variable Priv + scan [$w contentbox] "%d %d %d %d" x1 y1 x2 y2 + set margin [winfo pixels $w [$w cget -scrollmargin]] + if {($x < $x1 + $margin) || ($x >= $x2 - $margin) || + ($y < $y1 + $margin) || ($y >= $y2 - $margin)} { + if {![info exists Priv(autoscan,afterId,$w)]} { + if {$y >= $y2 - $margin} { + $w yview scroll 1 units + set delay [$w cget -yscrolldelay] + } elseif {$y < $y1 + $margin} { + $w yview scroll -1 units + set delay [$w cget -yscrolldelay] + } elseif {$x >= $x2 - $margin} { + $w xview scroll 1 units + set delay [$w cget -xscrolldelay] + } elseif {$x < $x1 + $margin} { + $w xview scroll -1 units + set delay [$w cget -xscrolldelay] + } + set count [scan $delay "%d %d" d1 d2] + if {[info exists Priv(autoscan,scanning,$w)]} { + if {$count == 2} { + set delay $d2 } - return + } else { + if {$count == 2} { + set delay $d1 + } + set Priv(autoscan,scanning,$w) 1 + } + Motion $w [$w index "nearest $x $y"] + set Priv(autoscan,afterId,$w) [after $delay [list TreeCtrl::AutoScanCheckAux $w]] } - AutoScanCancel $w return + } + AutoScanCancel $w + return } proc ::TreeCtrl::AutoScanCheckAux {w} { - variable Priv - # Not quite sure how this can happen - if {![info exists Priv(autoscan,afterId,$w)]} return - unset Priv(autoscan,afterId,$w) - set x [winfo pointerx $w] - set y [winfo pointery $w] - set x [expr {$x - [winfo rootx $w]}] - set y [expr {$y - [winfo rooty $w]}] - AutoScanCheck $w $x $y - return + variable Priv + # Not quite sure how this can happen + if {![info exists Priv(autoscan,afterId,$w)]} return + unset Priv(autoscan,afterId,$w) + set x [winfo pointerx $w] + set y [winfo pointery $w] + set x [expr {$x - [winfo rootx $w]}] + set y [expr {$y - [winfo rooty $w]}] + AutoScanCheck $w $x $y + return } proc ::TreeCtrl::AutoScanCancel {w} { - variable Priv - if {[info exists Priv(autoscan,afterId,$w)]} { - after cancel $Priv(autoscan,afterId,$w) - unset Priv(autoscan,afterId,$w) - } - unset -nocomplain Priv(autoscan,scanning,$w) - return + variable Priv + if {[info exists Priv(autoscan,afterId,$w)]} { + after cancel $Priv(autoscan,afterId,$w) + unset Priv(autoscan,afterId,$w) + } + unset -nocomplain Priv(autoscan,scanning,$w) + return } # ::TreeCtrl::UpDown -- @@ -676,7 +676,7 @@ proc ::TreeCtrl::UpDown {w n} { if {$rnc eq ""} return } scan $rnc "%d %d" row col - set Priv(row) [expr {$row + $n}] + set Priv(row) [expr {$row + $n}] if {$rnc ne $Priv(rnc)} { set Priv(col) $col } @@ -684,8 +684,8 @@ proc ::TreeCtrl::UpDown {w n} { if {[$w compare active == $index]} { set Priv(row) $row } else { - set Priv(rnc) [$w item rnc $index] - } + set Priv(rnc) [$w item rnc $index] + } return $index } @@ -705,13 +705,13 @@ proc ::TreeCtrl::LeftRight {w n} { if {[$w compare active == $index]} { set Priv(col) $col } else { - set Priv(rnc) [$w item rnc $index] - } + set Priv(rnc) [$w item rnc $index] + } return $index } proc ::TreeCtrl::SetActiveItem {w index} { - if {$index eq ""} return + if {$index eq ""} return $w activate $index $w see active $w selection modify active all @@ -830,42 +830,42 @@ proc ::TreeCtrl::SelectAll w { } proc ::TreeCtrl::MarqueeBegin {w x y} { - set x [$w canvasx $x] - set y [$w canvasy $y] - $w marquee coords $x $y $x $y - $w marquee visible yes - return + set x [$w canvasx $x] + set y [$w canvasy $y] + $w marquee coords $x $y $x $y + $w marquee visible yes + return } proc ::TreeCtrl::MarqueeUpdate {w x y} { - set x [$w canvasx $x] - set y [$w canvasy $y] - $w marquee corner $x $y - return + set x [$w canvasx $x] + set y [$w canvasy $y] + $w marquee corner $x $y + return } proc ::TreeCtrl::MarqueeEnd {w x y} { - $w marquee visible no - return + $w marquee visible no + return } proc ::TreeCtrl::ScanMark {w x y} { - variable Priv - $w scan mark $x $y - set Priv(x) $x - set Priv(y) $y - set Priv(mouseMoved) 0 - return + variable Priv + $w scan mark $x $y + set Priv(x) $x + set Priv(y) $y + set Priv(mouseMoved) 0 + return } proc ::TreeCtrl::ScanDrag {w x y} { - variable Priv - if {![info exists Priv(x)]} { set Priv(x) $x } - if {![info exists Priv(y)]} { set Priv(y) $y } - if {($x != $Priv(x)) || ($y != $Priv(y))} { - set Priv(mouseMoved) 1 - } - if {[info exists Priv(mouseMoved)] && $Priv(mouseMoved)} { - $w scan dragto $x $y - } - return + variable Priv + if {![info exists Priv(x)]} { set Priv(x) $x } + if {![info exists Priv(y)]} { set Priv(y) $y } + if {($x != $Priv(x)) || ($y != $Priv(y))} { + set Priv(mouseMoved) 1 + } + if {[info exists Priv(mouseMoved)] && $Priv(mouseMoved)} { + $w scan dragto $x $y + } + return } |