|
|
|
|
|
# iconlist.tcl
|
|
|
|
|
|
#
|
|
|
|
|
|
# Implements the icon-list megawidget used in the "Tk" standard file
|
|
|
|
|
|
# selection dialog boxes.
|
|
|
|
|
|
#
|
|
|
|
|
|
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
|
|
|
|
|
|
# Copyright (c) 2009 Donal K. Fellows
|
|
|
|
|
|
#
|
|
|
|
|
|
# See the file "license.terms" for information on usage and redistribution of
|
|
|
|
|
|
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
|
|
|
|
#
|
|
|
|
|
|
# API Summary:
|
|
|
|
|
|
# tk::IconList <path> ?<option> <value>? ...
|
|
|
|
|
|
# <path> add <imageName> <itemList>
|
|
|
|
|
|
# <path> cget <option>
|
|
|
|
|
|
# <path> configure ?<option>? ?<value>? ...
|
|
|
|
|
|
# <path> deleteall
|
|
|
|
|
|
# <path> destroy
|
|
|
|
|
|
# <path> get <itemIndex>
|
|
|
|
|
|
# <path> index <index>
|
|
|
|
|
|
# <path> invoke
|
|
|
|
|
|
# <path> see <index>
|
|
|
|
|
|
# <path> selection anchor ?<int>?
|
|
|
|
|
|
# <path> selection clear <first> ?<last>?
|
|
|
|
|
|
# <path> selection get
|
|
|
|
|
|
# <path> selection includes <item>
|
|
|
|
|
|
# <path> selection set <first> ?<last>?
|
|
|
|
|
|
|
|
|
|
|
|
package require Tk 8.6
|
|
|
|
|
|
|
|
|
|
|
|
::tk::Megawidget create ::tk::IconList ::tk::FocusableWidget {
|
|
|
|
|
|
variable w canvas sbar accel accelCB fill font index \
|
|
|
|
|
|
itemList itemsPerColumn list maxIH maxIW maxTH maxTW noScroll \
|
|
|
|
|
|
numItems oldX oldY options rect selected selection textList
|
|
|
|
|
|
constructor args {
|
|
|
|
|
|
next {*}$args
|
|
|
|
|
|
set accelCB {}
|
|
|
|
|
|
}
|
|
|
|
|
|
destructor {
|
|
|
|
|
|
my Reset
|
|
|
|
|
|
next
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
method GetSpecs {} {
|
|
|
|
|
|
concat [next] {
|
|
|
|
|
|
{-command "" "" ""}
|
|
|
|
|
|
{-font "" "" "TkIconFont"}
|
|
|
|
|
|
{-multiple "" "" "0"}
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# ----------------------------------------------------------------------
|
|
|
|
|
|
|
|
|
|
|
|
method index i {
|
|
|
|
|
|
if {![info exist list]} {
|
|
|
|
|
|
set list {}
|
|
|
|
|
|
}
|
|
|
|
|
|
switch -regexp -- $i {
|
|
|
|
|
|
"^-?[0-9]+$" {
|
|
|
|
|
|
if {$i < 0} {
|
|
|
|
|
|
set i 0
|
|
|
|
|
|
}
|
|
|
|
|
|
if {$i >= [llength $list]} {
|
|
|
|
|
|
set i [expr {[llength $list] - 1}]
|
|
|
|
|
|
}
|
|
|
|
|
|
return $i
|
|
|
|
|
|
}
|
|
|
|
|
|
"^anchor$" {
|
|
|
|
|
|
return $index(anchor)
|
|
|
|
|
|
}
|
|
|
|
|
|
"^end$" {
|
|
|
|
|
|
return [llength $list]
|
|
|
|
|
|
}
|
|
|
|
|
|
"@-?[0-9]+,-?[0-9]+" {
|
|
|
|
|
|
scan $i "@%d,%d" x y
|
|
|
|
|
|
set item [$canvas find closest \
|
|
|
|
|
|
[$canvas canvasx $x] [$canvas canvasy $y]]
|
|
|
|
|
|
return [lindex [$canvas itemcget $item -tags] 1]
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
method selection {op args} {
|
|
|
|
|
|
switch -exact -- $op {
|
|
|
|
|
|
anchor {
|
|
|
|
|
|
if {[llength $args] == 1} {
|
|
|
|
|
|
set index(anchor) [$w index [lindex $args 0]]
|
|
|
|
|
|
} else {
|
|
|
|
|
|
return $index(anchor)
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
clear {
|
|
|
|
|
|
switch [llength $args] {
|
|
|
|
|
|
2 {
|
|
|
|
|
|
lassign $args first last
|
|
|
|
|
|
}
|
|
|
|
|
|
1 {
|
|
|
|
|
|
set first [set last [lindex $args 0]]
|
|
|
|
|
|
}
|
|
|
|
|
|
default {
|
|
|
|
|
|
return -code error -errorcode {TCL WRONGARGS} \
|
|
|
|
|
|
"wrong # args: should be\
|
|
|
|
|
|
\"[lrange [info level 0] 0 1] first ?last?\""
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
set first [$w index $first]
|
|
|
|
|
|
set last [$w index $last]
|
|
|
|
|
|
if {$first > $last} {
|
|
|
|
|
|
set tmp $first
|
|
|
|
|
|
set first $last
|
|
|
|
|
|
set last $tmp
|
|
|
|
|
|
}
|
|
|
|
|
|
set ind 0
|
|
|
|
|
|
foreach item $selection {
|
|
|
|
|
|
if {$item >= $first} {
|
|
|
|
|
|
set first $ind
|
|
|
|
|
|
break
|
|
|
|
|
|
}
|
|
|
|
|
|
incr ind
|
|
|
|
|
|
}
|
|
|
|
|
|
set ind [expr {[llength $selection] - 1}]
|
|
|
|
|
|
for {} {$ind >= 0} {incr ind -1} {
|
|
|
|
|
|
set item [lindex $selection $ind]
|
|
|
|
|
|
if {$item <= $last} {
|
|
|
|
|
|
set last $ind
|
|
|
|
|
|
break
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
if {$first > $last} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
set selection [lreplace $selection $first $last]
|
|
|
|
|
|
event generate $w <<ListboxSelect>>
|
|
|
|
|
|
my DrawSelection
|
|
|
|
|
|
}
|
|
|
|
|
|
get {
|
|
|
|
|
|
return $selection
|
|
|
|
|
|
}
|
|
|
|
|
|
includes {
|
|
|
|
|
|
return [expr {[lindex $args 0] in $selection}]
|
|
|
|
|
|
}
|
|
|
|
|
|
set {
|
|
|
|
|
|
switch [llength $args] {
|
|
|
|
|
|
2 {
|
|
|
|
|
|
lassign $args first last
|
|
|
|
|
|
}
|
|
|
|
|
|
1 {
|
|
|
|
|
|
set first [set last [lindex $args 0]]
|
|
|
|
|
|
}
|
|
|
|
|
|
default {
|
|
|
|
|
|
return -code error -errorcode {TCL WRONGARGS} \
|
|
|
|
|
|
"wrong # args: should be\
|
|
|
|
|
|
\"[lrange [info level 0] 0 1] first ?last?\""
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
set first [$w index $first]
|
|
|
|
|
|
set last [$w index $last]
|
|
|
|
|
|
if {$first > $last} {
|
|
|
|
|
|
set tmp $first
|
|
|
|
|
|
set first $last
|
|
|
|
|
|
set last $tmp
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
for {set i $first} {$i <= $last} {incr i} {
|
|
|
|
|
|
lappend selection $i
|
|
|
|
|
|
}
|
|
|
|
|
|
set selection [lsort -integer -unique $selection]
|
|
|
|
|
|
event generate $w <<ListboxSelect>>
|
|
|
|
|
|
my DrawSelection
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
method get item {
|
|
|
|
|
|
set rTag [lindex $list $item 2]
|
|
|
|
|
|
lassign $itemList($rTag) iTag tTag text serial
|
|
|
|
|
|
return $text
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# Deletes all the items inside the canvas subwidget and reset the
|
|
|
|
|
|
# iconList's state.
|
|
|
|
|
|
#
|
|
|
|
|
|
method deleteall {} {
|
|
|
|
|
|
$canvas delete all
|
|
|
|
|
|
unset -nocomplain selected rect list itemList
|
|
|
|
|
|
set maxIW 1
|
|
|
|
|
|
set maxIH 1
|
|
|
|
|
|
set maxTW 1
|
|
|
|
|
|
set maxTH 1
|
|
|
|
|
|
set numItems 0
|
|
|
|
|
|
set noScroll 1
|
|
|
|
|
|
set selection {}
|
|
|
|
|
|
set index(anchor) ""
|
|
|
|
|
|
$sbar set 0.0 1.0
|
|
|
|
|
|
$canvas xview moveto 0
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# Adds an icon into the IconList with the designated image and text
|
|
|
|
|
|
#
|
|
|
|
|
|
method add {image items} {
|
|
|
|
|
|
foreach text $items {
|
|
|
|
|
|
set iID item$numItems
|
|
|
|
|
|
set iTag [$canvas create image 0 0 -image $image -anchor nw \
|
|
|
|
|
|
-tags [list icon $numItems $iID]]
|
|
|
|
|
|
set tTag [$canvas create text 0 0 -text $text -anchor nw \
|
|
|
|
|
|
-font $options(-font) -fill $fill \
|
|
|
|
|
|
-tags [list text $numItems $iID]]
|
|
|
|
|
|
set rTag [$canvas create rect 0 0 0 0 -fill "" -outline "" \
|
|
|
|
|
|
-tags [list rect $numItems $iID]]
|
|
|
|
|
|
|
|
|
|
|
|
lassign [$canvas bbox $iTag] x1 y1 x2 y2
|
|
|
|
|
|
set iW [expr {$x2 - $x1}]
|
|
|
|
|
|
set iH [expr {$y2 - $y1}]
|
|
|
|
|
|
if {$maxIW < $iW} {
|
|
|
|
|
|
set maxIW $iW
|
|
|
|
|
|
}
|
|
|
|
|
|
if {$maxIH < $iH} {
|
|
|
|
|
|
set maxIH $iH
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
lassign [$canvas bbox $tTag] x1 y1 x2 y2
|
|
|
|
|
|
set tW [expr {$x2 - $x1}]
|
|
|
|
|
|
set tH [expr {$y2 - $y1}]
|
|
|
|
|
|
if {$maxTW < $tW} {
|
|
|
|
|
|
set maxTW $tW
|
|
|
|
|
|
}
|
|
|
|
|
|
if {$maxTH < $tH} {
|
|
|
|
|
|
set maxTH $tH
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
lappend list [list $iTag $tTag $rTag $iW $iH $tW $tH $numItems]
|
|
|
|
|
|
set itemList($rTag) [list $iTag $tTag $text $numItems]
|
|
|
|
|
|
set textList($numItems) [string tolower $text]
|
|
|
|
|
|
incr numItems
|
|
|
|
|
|
}
|
|
|
|
|
|
my WhenIdle Arrange
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# Gets called when the user invokes the IconList (usually by
|
|
|
|
|
|
# double-clicking or pressing the Return key).
|
|
|
|
|
|
#
|
|
|
|
|
|
method invoke {} {
|
|
|
|
|
|
if {$options(-command) ne "" && [llength $selection]} {
|
|
|
|
|
|
uplevel #0 $options(-command)
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# If the item is not (completely) visible, scroll the canvas so that it
|
|
|
|
|
|
# becomes visible.
|
|
|
|
|
|
#
|
|
|
|
|
|
method see rTag {
|
|
|
|
|
|
if {$noScroll} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
set sRegion [$canvas cget -scrollregion]
|
|
|
|
|
|
if {$sRegion eq ""} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
if {$rTag < 0 || $rTag >= [llength $list]} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
set bbox [$canvas bbox item$rTag]
|
|
|
|
|
|
set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}]
|
|
|
|
|
|
|
|
|
|
|
|
set x1 [lindex $bbox 0]
|
|
|
|
|
|
set x2 [lindex $bbox 2]
|
|
|
|
|
|
incr x1 [expr {$pad * -2}]
|
|
|
|
|
|
incr x2 [expr {$pad * -1}]
|
|
|
|
|
|
|
|
|
|
|
|
set cW [expr {[winfo width $canvas] - $pad*2}]
|
|
|
|
|
|
|
|
|
|
|
|
set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
|
|
|
|
|
|
set dispX [expr {int([lindex [$canvas xview] 0]*$scrollW)}]
|
|
|
|
|
|
set oldDispX $dispX
|
|
|
|
|
|
|
|
|
|
|
|
# check if out of the right edge
|
|
|
|
|
|
#
|
|
|
|
|
|
if {($x2 - $dispX) >= $cW} {
|
|
|
|
|
|
set dispX [expr {$x2 - $cW}]
|
|
|
|
|
|
}
|
|
|
|
|
|
# check if out of the left edge
|
|
|
|
|
|
#
|
|
|
|
|
|
if {($x1 - $dispX) < 0} {
|
|
|
|
|
|
set dispX $x1
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
if {$oldDispX ne $dispX} {
|
|
|
|
|
|
set fraction [expr {double($dispX) / double($scrollW)}]
|
|
|
|
|
|
$canvas xview moveto $fraction
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# ----------------------------------------------------------------------
|
|
|
|
|
|
|
|
|
|
|
|
# Places the icons in a column-major arrangement.
|
|
|
|
|
|
#
|
|
|
|
|
|
method Arrange {} {
|
|
|
|
|
|
if {![info exists list]} {
|
|
|
|
|
|
if {[info exists canvas] && [winfo exists $canvas]} {
|
|
|
|
|
|
set noScroll 1
|
|
|
|
|
|
$sbar configure -command ""
|
|
|
|
|
|
}
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
set W [winfo width $canvas]
|
|
|
|
|
|
set H [winfo height $canvas]
|
|
|
|
|
|
set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}]
|
|
|
|
|
|
if {$pad < 2} {
|
|
|
|
|
|
set pad 2
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
incr W [expr {$pad*-2}]
|
|
|
|
|
|
incr H [expr {$pad*-2}]
|
|
|
|
|
|
|
|
|
|
|
|
set dx [expr {$maxIW + $maxTW + 8}]
|
|
|
|
|
|
if {$maxTH > $maxIH} {
|
|
|
|
|
|
set dy $maxTH
|
|
|
|
|
|
} else {
|
|
|
|
|
|
set dy $maxIH
|
|
|
|
|
|
}
|
|
|
|
|
|
incr dy 2
|
|
|
|
|
|
set shift [expr {$maxIW + 4}]
|
|
|
|
|
|
|
|
|
|
|
|
set x [expr {$pad * 2}]
|
|
|
|
|
|
set y [expr {$pad * 1}] ; # Why * 1 ?
|
|
|
|
|
|
set usedColumn 0
|
|
|
|
|
|
foreach sublist $list {
|
|
|
|
|
|
set usedColumn 1
|
|
|
|
|
|
lassign $sublist iTag tTag rTag iW iH tW tH
|
|
|
|
|
|
|
|
|
|
|
|
set i_dy [expr {($dy - $iH)/2}]
|
|
|
|
|
|
set t_dy [expr {($dy - $tH)/2}]
|
|
|
|
|
|
|
|
|
|
|
|
$canvas coords $iTag $x [expr {$y + $i_dy}]
|
|
|
|
|
|
$canvas coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]
|
|
|
|
|
|
$canvas coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
|
|
|
|
|
|
|
|
|
|
|
|
incr y $dy
|
|
|
|
|
|
if {($y + $dy) > $H} {
|
|
|
|
|
|
set y [expr {$pad * 1}] ; # *1 ?
|
|
|
|
|
|
incr x $dx
|
|
|
|
|
|
set usedColumn 0
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
if {$usedColumn} {
|
|
|
|
|
|
set sW [expr {$x + $dx}]
|
|
|
|
|
|
} else {
|
|
|
|
|
|
set sW $x
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
if {$sW < $W} {
|
|
|
|
|
|
$canvas configure -scrollregion [list $pad $pad $sW $H]
|
|
|
|
|
|
$sbar configure -command ""
|
|
|
|
|
|
$canvas xview moveto 0
|
|
|
|
|
|
set noScroll 1
|
|
|
|
|
|
} else {
|
|
|
|
|
|
$canvas configure -scrollregion [list $pad $pad $sW $H]
|
|
|
|
|
|
$sbar configure -command [list $canvas xview]
|
|
|
|
|
|
set noScroll 0
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
set itemsPerColumn [expr {($H-$pad) / $dy}]
|
|
|
|
|
|
if {$itemsPerColumn < 1} {
|
|
|
|
|
|
set itemsPerColumn 1
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
my DrawSelection
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
method DrawSelection {} {
|
|
|
|
|
|
$canvas delete selection
|
|
|
|
|
|
$canvas itemconfigure selectionText -fill black
|
|
|
|
|
|
$canvas dtag selectionText
|
|
|
|
|
|
set cbg [ttk::style lookup TEntry -selectbackground focus]
|
|
|
|
|
|
set cfg [ttk::style lookup TEntry -selectforeground focus]
|
|
|
|
|
|
foreach item $selection {
|
|
|
|
|
|
set rTag [lindex $list $item 2]
|
|
|
|
|
|
foreach {iTag tTag text serial} $itemList($rTag) {
|
|
|
|
|
|
break
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
set bbox [$canvas bbox $tTag]
|
|
|
|
|
|
$canvas create rect $bbox -fill $cbg -outline $cbg \
|
|
|
|
|
|
-tags selection
|
|
|
|
|
|
$canvas itemconfigure $tTag -fill $cfg -tags selectionText
|
|
|
|
|
|
}
|
|
|
|
|
|
$canvas lower selection
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# Creates an IconList widget by assembling a canvas widget and a
|
|
|
|
|
|
# scrollbar widget. Sets all the bindings necessary for the IconList's
|
|
|
|
|
|
# operations.
|
|
|
|
|
|
#
|
|
|
|
|
|
method Create {} {
|
|
|
|
|
|
variable hull
|
|
|
|
|
|
set sbar [ttk::scrollbar $hull.sbar -orient horizontal -takefocus 0]
|
|
|
|
|
|
catch {$sbar configure -highlightthickness 0}
|
|
|
|
|
|
set canvas [canvas $hull.canvas -highlightthick 0 -takefocus 1 \
|
|
|
|
|
|
-width 400 -height 120 -background white]
|
|
|
|
|
|
pack $sbar -side bottom -fill x -padx 2 -pady {0 2}
|
|
|
|
|
|
pack $canvas -expand yes -fill both -padx 2 -pady {2 0}
|
|
|
|
|
|
|
|
|
|
|
|
$sbar configure -command [list $canvas xview]
|
|
|
|
|
|
$canvas configure -xscrollcommand [list $sbar set]
|
|
|
|
|
|
|
|
|
|
|
|
# Initializes the max icon/text width and height and other variables
|
|
|
|
|
|
#
|
|
|
|
|
|
set maxIW 1
|
|
|
|
|
|
set maxIH 1
|
|
|
|
|
|
set maxTW 1
|
|
|
|
|
|
set maxTH 1
|
|
|
|
|
|
set numItems 0
|
|
|
|
|
|
set noScroll 1
|
|
|
|
|
|
set selection {}
|
|
|
|
|
|
set index(anchor) ""
|
|
|
|
|
|
set fg [option get $canvas foreground Foreground]
|
|
|
|
|
|
if {$fg eq ""} {
|
|
|
|
|
|
set fill black
|
|
|
|
|
|
} else {
|
|
|
|
|
|
set fill $fg
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# Creates the event bindings.
|
|
|
|
|
|
#
|
|
|
|
|
|
bind $canvas <Configure> [namespace code {my WhenIdle Arrange}]
|
|
|
|
|
|
|
|
|
|
|
|
bind $canvas <1> [namespace code {my Btn1 %x %y}]
|
|
|
|
|
|
bind $canvas <B1-Motion> [namespace code {my Motion1 %x %y}]
|
|
|
|
|
|
bind $canvas <B1-Leave> [namespace code {my Leave1 %x %y}]
|
|
|
|
|
|
bind $canvas <Control-1> [namespace code {my CtrlBtn1 %x %y}]
|
|
|
|
|
|
bind $canvas <Shift-1> [namespace code {my ShiftBtn1 %x %y}]
|
|
|
|
|
|
bind $canvas <B1-Enter> [list tk::CancelRepeat]
|
|
|
|
|
|
bind $canvas <ButtonRelease-1> [list tk::CancelRepeat]
|
|
|
|
|
|
bind $canvas <Double-ButtonRelease-1> \
|
|
|
|
|
|
[namespace code {my Double1 %x %y}]
|
|
|
|
|
|
|
|
|
|
|
|
bind $canvas <Control-B1-Motion> {;}
|
|
|
|
|
|
bind $canvas <Shift-B1-Motion> [namespace code {my ShiftMotion1 %x %y}]
|
|
|
|
|
|
|
|
|
|
|
|
bind $canvas <<PrevLine>> [namespace code {my UpDown -1}]
|
|
|
|
|
|
bind $canvas <<NextLine>> [namespace code {my UpDown 1}]
|
|
|
|
|
|
bind $canvas <<PrevChar>> [namespace code {my LeftRight -1}]
|
|
|
|
|
|
bind $canvas <<NextChar>> [namespace code {my LeftRight 1}]
|
|
|
|
|
|
bind $canvas <Return> [namespace code {my ReturnKey}]
|
|
|
|
|
|
bind $canvas <KeyPress> [namespace code {my KeyPress %A}]
|
|
|
|
|
|
bind $canvas <Control-KeyPress> ";"
|
|
|
|
|
|
bind $canvas <Alt-KeyPress> ";"
|
|
|
|
|
|
|
|
|
|
|
|
bind $canvas <FocusIn> [namespace code {my FocusIn}]
|
|
|
|
|
|
bind $canvas <FocusOut> [namespace code {my FocusOut}]
|
|
|
|
|
|
|
|
|
|
|
|
return $w
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# This procedure is invoked when the mouse leaves an entry window with
|
|
|
|
|
|
# button 1 down. It scrolls the window up, down, left, or right,
|
|
|
|
|
|
# depending on where the mouse left the window, and reschedules itself
|
|
|
|
|
|
# as an "after" command so that the window continues to scroll until the
|
|
|
|
|
|
# mouse moves back into the window or the mouse button is released.
|
|
|
|
|
|
#
|
|
|
|
|
|
method AutoScan {} {
|
|
|
|
|
|
if {![winfo exists $w]} return
|
|
|
|
|
|
set x $oldX
|
|
|
|
|
|
set y $oldY
|
|
|
|
|
|
if {$noScroll} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
if {$x >= [winfo width $canvas]} {
|
|
|
|
|
|
$canvas xview scroll 1 units
|
|
|
|
|
|
} elseif {$x < 0} {
|
|
|
|
|
|
$canvas xview scroll -1 units
|
|
|
|
|
|
} elseif {$y >= [winfo height $canvas]} {
|
|
|
|
|
|
# do nothing
|
|
|
|
|
|
} elseif {$y < 0} {
|
|
|
|
|
|
# do nothing
|
|
|
|
|
|
} else {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
my Motion1 $x $y
|
|
|
|
|
|
set ::tk::Priv(afterId) [after 50 [namespace code {my AutoScan}]]
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# ----------------------------------------------------------------------
|
|
|
|
|
|
|
|
|
|
|
|
# Event handlers
|
|
|
|
|
|
method Btn1 {x y} {
|
|
|
|
|
|
focus $canvas
|
|
|
|
|
|
set i [$w index @$x,$y]
|
|
|
|
|
|
if {$i eq ""} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
$w selection clear 0 end
|
|
|
|
|
|
$w selection set $i
|
|
|
|
|
|
$w selection anchor $i
|
|
|
|
|
|
}
|
|
|
|
|
|
method CtrlBtn1 {x y} {
|
|
|
|
|
|
if {$options(-multiple)} {
|
|
|
|
|
|
focus $canvas
|
|
|
|
|
|
set i [$w index @$x,$y]
|
|
|
|
|
|
if {$i eq ""} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
if {[$w selection includes $i]} {
|
|
|
|
|
|
$w selection clear $i
|
|
|
|
|
|
} else {
|
|
|
|
|
|
$w selection set $i
|
|
|
|
|
|
$w selection anchor $i
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
method ShiftBtn1 {x y} {
|
|
|
|
|
|
if {$options(-multiple)} {
|
|
|
|
|
|
focus $canvas
|
|
|
|
|
|
set i [$w index @$x,$y]
|
|
|
|
|
|
if {$i eq ""} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
if {[$w index anchor] eq ""} {
|
|
|
|
|
|
$w selection anchor $i
|
|
|
|
|
|
}
|
|
|
|
|
|
$w selection clear 0 end
|
|
|
|
|
|
$w selection set anchor $i
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# Gets called on button-1 motions
|
|
|
|
|
|
#
|
|
|
|
|
|
method Motion1 {x y} {
|
|
|
|
|
|
set oldX $x
|
|
|
|
|
|
set oldY $y
|
|
|
|
|
|
set i [$w index @$x,$y]
|
|
|
|
|
|
if {$i eq ""} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
$w selection clear 0 end
|
|
|
|
|
|
$w selection set $i
|
|
|
|
|
|
}
|
|
|
|
|
|
method ShiftMotion1 {x y} {
|
|
|
|
|
|
set oldX $x
|
|
|
|
|
|
set oldY $y
|
|
|
|
|
|
set i [$w index @$x,$y]
|
|
|
|
|
|
if {$i eq ""} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
$w selection clear 0 end
|
|
|
|
|
|
$w selection set anchor $i
|
|
|
|
|
|
}
|
|
|
|
|
|
method Double1 {x y} {
|
|
|
|
|
|
if {[llength $selection]} {
|
|
|
|
|
|
$w invoke
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
method ReturnKey {} {
|
|
|
|
|
|
$w invoke
|
|
|
|
|
|
}
|
|
|
|
|
|
method Leave1 {x y} {
|
|
|
|
|
|
set oldX $x
|
|
|
|
|
|
set oldY $y
|
|
|
|
|
|
my AutoScan
|
|
|
|
|
|
}
|
|
|
|
|
|
method FocusIn {} {
|
|
|
|
|
|
$w state focus
|
|
|
|
|
|
if {![info exists list]} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
if {[llength $selection]} {
|
|
|
|
|
|
my DrawSelection
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
method FocusOut {} {
|
|
|
|
|
|
$w state !focus
|
|
|
|
|
|
$w selection clear 0 end
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# Moves the active element up or down by one element
|
|
|
|
|
|
#
|
|
|
|
|
|
# Arguments:
|
|
|
|
|
|
# amount - +1 to move down one item, -1 to move back one item.
|
|
|
|
|
|
#
|
|
|
|
|
|
method UpDown amount {
|
|
|
|
|
|
if {![info exists list]} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
set curr [$w selection get]
|
|
|
|
|
|
if {[llength $curr] == 0} {
|
|
|
|
|
|
set i 0
|
|
|
|
|
|
} else {
|
|
|
|
|
|
set i [$w index anchor]
|
|
|
|
|
|
if {$i eq ""} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
incr i $amount
|
|
|
|
|
|
}
|
|
|
|
|
|
$w selection clear 0 end
|
|
|
|
|
|
$w selection set $i
|
|
|
|
|
|
$w selection anchor $i
|
|
|
|
|
|
$w see $i
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# Moves the active element left or right by one column
|
|
|
|
|
|
#
|
|
|
|
|
|
# Arguments:
|
|
|
|
|
|
# amount - +1 to move right one column, -1 to move left one
|
|
|
|
|
|
# column
|
|
|
|
|
|
#
|
|
|
|
|
|
method LeftRight amount {
|
|
|
|
|
|
if {![info exists list]} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
set curr [$w selection get]
|
|
|
|
|
|
if {[llength $curr] == 0} {
|
|
|
|
|
|
set i 0
|
|
|
|
|
|
} else {
|
|
|
|
|
|
set i [$w index anchor]
|
|
|
|
|
|
if {$i eq ""} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
incr i [expr {$amount * $itemsPerColumn}]
|
|
|
|
|
|
}
|
|
|
|
|
|
$w selection clear 0 end
|
|
|
|
|
|
$w selection set $i
|
|
|
|
|
|
$w selection anchor $i
|
|
|
|
|
|
$w see $i
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
# Gets called when user enters an arbitrary key in the listbox.
|
|
|
|
|
|
#
|
|
|
|
|
|
method KeyPress key {
|
|
|
|
|
|
append accel $key
|
|
|
|
|
|
my Goto $accel
|
|
|
|
|
|
after cancel $accelCB
|
|
|
|
|
|
set accelCB [after 500 [namespace code {my Reset}]]
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
method Goto text {
|
|
|
|
|
|
if {![info exists list]} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
if {$text eq "" || $numItems == 0} {
|
|
|
|
|
|
return
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
if {[llength [$w selection get]]} {
|
|
|
|
|
|
set start [$w index anchor]
|
|
|
|
|
|
} else {
|
|
|
|
|
|
set start 0
|
|
|
|
|
|
}
|
|
|
|
|
|
set theIndex -1
|
|
|
|
|
|
set less 0
|
|
|
|
|
|
set len [string length $text]
|
|
|
|
|
|
set len0 [expr {$len - 1}]
|
|
|
|
|
|
set i $start
|
|
|
|
|
|
|
|
|
|
|
|
# Search forward until we find a filename whose prefix is a
|
|
|
|
|
|
# case-insensitive match with $text
|
|
|
|
|
|
while {1} {
|
|
|
|
|
|
if {[string equal -nocase -length $len0 $textList($i) $text]} {
|
|
|
|
|
|
set theIndex $i
|
|
|
|
|
|
break
|
|
|
|
|
|
}
|
|
|
|
|
|
incr i
|
|
|
|
|
|
if {$i == $numItems} {
|
|
|
|
|
|
set i 0
|
|
|
|
|
|
}
|
|
|
|
|
|
if {$i == $start} {
|
|
|
|
|
|
break
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
if {$theIndex > -1} {
|
|
|
|
|
|
$w selection clear 0 end
|
|
|
|
|
|
$w selection set $theIndex
|
|
|
|
|
|
$w selection anchor $theIndex
|
|
|
|
|
|
$w see $theIndex
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
method Reset {} {
|
|
|
|
|
|
unset -nocomplain accel
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
|
|
# Local Variables:
|
|
|
|
|
|
# mode: tcl
|
|
|
|
|
|
# fill-column: 78
|
|
|
|
|
|
# End:
|
