%PDF- %PDF-
Direktori : /lib64/tcl8.6/Tix8.4.3/ |
Current File : //lib64/tcl8.6/Tix8.4.3/TList.tcl |
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*- # # $Id: TList.tcl,v 1.6 2002/01/24 09:13:58 idiscovery Exp $ # # TList.tcl -- # # This file defines the default bindings for Tix Tabular Listbox # widgets. # # Copyright (c) 1993-1999 Ioi Kim Lam. # Copyright (c) 2000-2001 Tix Project Group. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # global tkPriv if {![llength [info globals tkPriv]]} { tk::unsupported::ExposePrivateVariable tkPriv } #-------------------------------------------------------------------------- # tkPriv elements used in this file: # # afterId - Token returned by "after" for autoscanning. # fakeRelease - Cancel the ButtonRelease-1 after the user double click #-------------------------------------------------------------------------- # proc tixTListBind {} { tixBind TixTList <ButtonPress-1> { tixTList:Button-1 %W %x %y } tixBind TixTList <Shift-ButtonPress-1> { tixTList:Shift-Button-1 %W %x %y } tixBind TixTList <Control-ButtonPress-1> { tixTList:Control-Button-1 %W %x %y } tixBind TixTList <ButtonRelease-1> { tixTList:ButtonRelease-1 %W %x %y } tixBind TixTList <Double-ButtonPress-1> { tixTList:Double-1 %W %x %y } tixBind TixTList <B1-Motion> { set tkPriv(x) %x set tkPriv(y) %y set tkPriv(X) %X set tkPriv(Y) %Y tixTList:B1-Motion %W %x %y } tixBind TixTList <Control-B1-Motion> { set tkPriv(x) %x set tkPriv(y) %y set tkPriv(X) %X set tkPriv(Y) %Y tixTList:Control-B1-Motion %W %x %y } tixBind TixTList <B1-Leave> { set tkPriv(x) %x set tkPriv(y) %y set tkPriv(X) %X set tkPriv(Y) %Y tixTList:B1-Leave %W } tixBind TixTList <B1-Enter> { tixTList:B1-Enter %W %x %y } tixBind TixTList <Control-B1-Leave> { set tkPriv(x) %x set tkPriv(y) %y set tkPriv(X) %X set tkPriv(Y) %Y tixTList:Control-B1-Leave %W } tixBind TixTList <Control-B1-Enter> { tixTList:Control-B1-Enter %W %x %y } # Keyboard bindings # tixBind TixTList <Up> { tixTList:DirKey %W up } tixBind TixTList <Down> { tixTList:DirKey %W down } tixBind TixTList <Left> { tixTList:DirKey %W left } tixBind TixTList <Right> { tixTList:DirKey %W right } tixBind TixTList <Prior> { %W yview scroll -1 pages } tixBind TixTList <Next> { %W yview scroll 1 pages } tixBind TixTList <Return> { tixTList:Return %W } tixBind TixTList <space> { tixTList:Space %W } # # Don't use tixBind because %A causes Tk 8.3.2 to crash # bind TixTList <MouseWheel> { if {"[%W cget -orient]" == "vertical"} { %W xview scroll [expr {- (%D / 120) * 4}] units } else { %W yview scroll [expr {- (%D / 120) * 2}] units } } } #---------------------------------------------------------------------- # # # Mouse bindings # # #---------------------------------------------------------------------- proc tixTList:Button-1 {w x y} { if {[$w cget -state] == "disabled"} { return } if {[$w cget -takefocus]} { focus $w } case [tixTList:GetState $w] { {s0} { tixTList:GoState s1 $w $x $y } {b0} { tixTList:GoState b1 $w $x $y } {m0} { tixTList:GoState m1 $w $x $y } {e0} { tixTList:GoState e1 $w $x $y } } } proc tixTList:Shift-Button-1 {w x y} { if {[$w cget -state] == "disabled"} { return } if {[$w cget -takefocus]} { focus $w } case [tixTList:GetState $w] { {s0} { tixTList:GoState s1 $w $x $y } {b0} { tixTList:GoState b1 $w $x $y } {m0} { tixTList:GoState m7 $w $x $y } {e0} { tixTList:GoState e7 $w $x $y } } } proc tixTList:Control-Button-1 {w x y} { if {[$w cget -state] == "disabled"} { return } if {[$w cget -takefocus]} { focus $w } case [tixTList:GetState $w] { {s0} { tixTList:GoState s1 $w $x $y } {b0} { tixTList:GoState b1 $w $x $y } {m0} { tixTList:GoState m1 $w $x $y } {e0} { tixTList:GoState e10 $w $x $y } } } proc tixTList:ButtonRelease-1 {w x y} { case [tixTList:GetState $w] { {s2 s4 s5 s6} { tixTList:GoState s3 $w } {b2 b4 b5 b6} { tixTList:GoState b3 $w } {m2} { tixTList:GoState m3 $w } {m5} { tixTList:GoState m6 $w $x $y } {m9} { tixTList:GoState m0 $w } {e2} { tixTList:GoState e3 $w } {e5} { tixTList:GoState e6 $w $x $y } {e9} { tixTList:GoState e0 $w } } } proc tixTList:B1-Motion {w x y} { case [tixTList:GetState $w] { {s2 s4} { tixTList:GoState s4 $w $x $y } {b2 b4} { tixTList:GoState b4 $w $x $y } {m2 m5} { tixTList:GoState m4 $w $x $y } {e2 e5} { tixTList:GoState e4 $w $x $y } } } proc tixTList:Control-B1-Motion {w x y} { case [tixTList:GetState $w] { {s2 s4} { tixTList:GoState s4 $w $x $y } {b2 b4} { tixTList:GoState b4 $w $x $y } {m2 m5} { tixTList:GoState m4 $w $x $y } } } proc tixTList:Double-1 {w x y} { case [tixTList:GetState $w] { {s0} { tixTList:GoState s7 $w $x $y } {b0} { tixTList:GoState b7 $w $x $y } } } proc tixTList:B1-Leave {w} { case [tixTList:GetState $w] { {s2 s4} { tixTList:GoState s5 $w } {b2 b4} { tixTList:GoState b5 $w } {m2 m5} { tixTList:GoState m8 $w } {e2 e5} { tixTList:GoState e8 $w } } } proc tixTList:B1-Enter {w x y} { case [tixTList:GetState $w] { {s5 s6} { tixTList:GoState s4 $w $x $y } {b5 b6} { tixTList:GoState b4 $w $x $y } {m8 m9} { tixTList:GoState m4 $w $x $y } {e8 e9} { tixTList:GoState e4 $w $x $y } } } proc tixTList:Control-B1-Leave {w} { case [tixTList:GetState $w] { {s2 s4} { tixTList:GoState s5 $w } {b2 b4} { tixTList:GoState b5 $w } {m2 m5} { tixTList:GoState m8 $w } } } proc tixTList:Control-B1-Enter {w x y} { case [tixTList:GetState $w] { {s5 s6} { tixTList:GoState s4 $w $x $y } {b5 b6} { tixTList:GoState b4 $w $x $y } {m8 m9} { tixTList:GoState m4 $w $x $y } } } proc tixTList:AutoScan {w} { case [tixTList:GetState $w] { {s5 s6} { tixTList:GoState s6 $w } {b5 b6} { tixTList:GoState b6 $w } {m8 m9} { tixTList:GoState m9 $w } {e8 e9} { tixTList:GoState e9 $w } } } #---------------------------------------------------------------------- # # # Key bindings # # #---------------------------------------------------------------------- proc tixTList:DirKey {w key} { if {[$w cget -state] == "disabled"} { return } case [tixTList:GetState $w] { {s0} { tixTList:GoState s8 $w $key } {b0} { tixTList:GoState b8 $w $key } } } proc tixTList:Return {w} { if {[$w cget -state] == "disabled"} { return } case [tixTList:GetState $w] { {s0} { tixTList:GoState s9 $w } {b0} { tixTList:GoState b9 $w } } } proc tixTList:Space {w} { if {[$w cget -state] == "disabled"} { return } case [tixTList:GetState $w] { {s0} { tixTList:GoState s10 $w } {b0} { tixTList:GoState b10 $w } } } #---------------------------------------------------------------------- # # STATE MANIPULATION # # #---------------------------------------------------------------------- proc tixTList:GetState {w} { global $w:priv:state if {[info exists $w:priv:state]} { # # If the app has changed the selectmode, reset the state to the # original state. # set type [string index [$w cget -selectmode] 0] if {"[string index [set $w:priv:state] 0]" != "$type"} { unset $w:priv:state } } if {![info exists $w:priv:state]} { case [$w cget -selectmode] { single { set $w:priv:state s0 } browse { set $w:priv:state b0 } multiple { set $w:priv:state m0 } extended { set $w:priv:state e0 } default { set $w:priv:state unknown } } } return [set $w:priv:state] } proc tixTList:SetState {w n} { global $w:priv:state set $w:priv:state $n } proc tixTList:GoState {n w args} { # puts "going from [tixTList:GetState $w] --> $n" tixTList:SetState $w $n eval tixTList:GoState-$n $w $args } #---------------------------------------------------------------------- # States #---------------------------------------------------------------------- #---------------------------------------------------------------------- # SINGLE SELECTION #---------------------------------------------------------------------- proc tixTList:GoState-s0 {w} { } proc tixTList:GoState-s1 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { $w anchor set $ent $w see $ent } tixTList:GoState s2 $w } proc tixTList:GoState-s2 {w} { } proc tixTList:GoState-s3 {w} { set ent [$w info anchor] if {$ent != ""} { $w selection clear $w selection set $ent tixTList:CallBrowseCmd $w $ent } tixTList:GoState s0 $w } proc tixTList:GoState-s4 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { $w anchor set $ent $w see $ent } } proc tixTList:GoState-s5 {w} { tixTList:StartScan $w } proc tixTList:GoState-s6 {w} { global tkPriv tixTList:DoScan $w } proc tixTList:GoState-s7 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { $w selection clear $w selection set $ent tixTList:CallCommand $w $ent } tixTList:GoState s0 $w } proc tixTList:GoState-s8 {w key} { set anchor [$w info anchor] if {$anchor == ""} { set anchor 0 } else { set anchor [$w info $key $anchor] } $w anchor set $anchor $w see $anchor tixTList:GoState s0 $w } proc tixTList:GoState-s9 {w} { set anchor [$w info anchor] if {$anchor == ""} { set anchor 0 $w anchor set $anchor $w see $anchor } if {[$w info anchor] != ""} { # ! may not have any elements # tixTList:CallCommand $w [$w info anchor] $w selection clear $w selection set $anchor } tixTList:GoState s0 $w } proc tixTList:GoState-s10 {w} { set anchor [$w info anchor] if {$anchor == ""} { set anchor 0 $w anchor set $anchor $w see $anchor } if {[$w info anchor] != ""} { # ! may not have any elements # tixTList:CallBrowseCmd $w [$w info anchor] $w selection clear $w selection set $anchor } tixTList:GoState s0 $w } #---------------------------------------------------------------------- # BROWSE SELECTION #---------------------------------------------------------------------- proc tixTList:GoState-b0 {w} { } proc tixTList:GoState-b1 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { $w anchor set $ent $w see $ent $w selection clear $w selection set $ent tixTList:CallBrowseCmd $w $ent } tixTList:GoState b2 $w } proc tixTList:GoState-b2 {w} { } proc tixTList:GoState-b3 {w} { set ent [$w info anchor] if {$ent != ""} { $w selection clear $w selection set $ent tixTList:CallBrowseCmd $w $ent } tixTList:GoState b0 $w } proc tixTList:GoState-b4 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { $w anchor set $ent $w see $ent $w selection clear $w selection set $ent tixTList:CallBrowseCmd $w $ent } } proc tixTList:GoState-b5 {w} { tixTList:StartScan $w } proc tixTList:GoState-b6 {w} { global tkPriv tixTList:DoScan $w } proc tixTList:GoState-b7 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { $w selection clear $w selection set $ent tixTList:CallCommand $w $ent } tixTList:GoState b0 $w } proc tixTList:GoState-b8 {w key} { set anchor [$w info anchor] if {$anchor == ""} { set anchor 0 } else { set anchor [$w info $key $anchor] } $w anchor set $anchor $w selection clear $w selection set $anchor $w see $anchor tixTList:CallBrowseCmd $w $anchor tixTList:GoState b0 $w } proc tixTList:GoState-b9 {w} { set anchor [$w info anchor] if {$anchor == ""} { set anchor 0 $w anchor set $anchor $w see $anchor } if {[$w info anchor] != ""} { # ! may not have any elements # tixTList:CallCommand $w [$w info anchor] $w selection clear $w selection set $anchor } tixTList:GoState b0 $w } proc tixTList:GoState-b10 {w} { set anchor [$w info anchor] if {$anchor == ""} { set anchor 0 $w anchor set $anchor $w see $anchor } if {[$w info anchor] != ""} { # ! may not have any elements # tixTList:CallBrowseCmd $w [$w info anchor] $w selection clear $w selection set $anchor } tixTList:GoState b0 $w } #---------------------------------------------------------------------- # MULTIPLE SELECTION #---------------------------------------------------------------------- proc tixTList:GoState-m0 {w} { } proc tixTList:GoState-m1 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { $w anchor set $ent $w see $ent $w selection clear $w selection set $ent tixTList:CallBrowseCmd $w $ent } tixTList:GoState m2 $w } proc tixTList:GoState-m2 {w} { } proc tixTList:GoState-m3 {w} { set ent [$w info anchor] if {$ent != ""} { tixTList:CallBrowseCmd $w $ent } tixTList:GoState m0 $w } proc tixTList:GoState-m4 {w x y} { set from [$w info anchor] set to [$w nearest $x $y] if {$to != ""} { $w selection clear $w selection set $from $to tixTList:CallBrowseCmd $w $to } tixTList:GoState m5 $w } proc tixTList:GoState-m5 {w} { } proc tixTList:GoState-m6 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { tixTList:CallBrowseCmd $w $ent } tixTList:GoState m0 $w } proc tixTList:GoState-m7 {w x y} { set from [$w info anchor] set to [$w nearest $x $y] if {$from == ""} { set from $to $w anchor set $from $w see $from } if {$to != ""} { $w selection clear $w selection set $from $to tixTList:CallBrowseCmd $w $to } tixTList:GoState m5 $w } proc tixTList:GoState-m8 {w} { tixTList:StartScan $w } proc tixTList:GoState-m9 {w} { tixTList:DoScan $w } proc tixTList:GoState-xm7 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { $w selection clear $w selection set $ent tixTList:CallCommand $w $ent } tixTList:GoState m0 $w } #---------------------------------------------------------------------- # EXTENDED SELECTION #---------------------------------------------------------------------- proc tixTList:GoState-e0 {w} { } proc tixTList:GoState-e1 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { $w anchor set $ent $w see $ent $w selection clear $w selection set $ent tixTList:CallBrowseCmd $w $ent } tixTList:GoState e2 $w } proc tixTList:GoState-e2 {w} { } proc tixTList:GoState-e3 {w} { set ent [$w info anchor] if {$ent != ""} { tixTList:CallBrowseCmd $w $ent } tixTList:GoState e0 $w } proc tixTList:GoState-e4 {w x y} { set from [$w info anchor] set to [$w nearest $x $y] if {$to != ""} { $w selection clear $w selection set $from $to tixTList:CallBrowseCmd $w $to } tixTList:GoState e5 $w } proc tixTList:GoState-e5 {w} { } proc tixTList:GoState-e6 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { tixTList:CallBrowseCmd $w $ent } tixTList:GoState e0 $w } proc tixTList:GoState-e7 {w x y} { set from [$w info anchor] set to [$w nearest $x $y] if {$from == ""} { set from $to $w anchor set $from $w see $from } if {$to != ""} { $w selection clear $w selection set $from $to tixTList:CallBrowseCmd $w $to } tixTList:GoState e5 $w } proc tixTList:GoState-e8 {w} { tixTList:StartScan $w } proc tixTList:GoState-e9 {w} { tixTList:DoScan $w } proc tixTList:GoState-e10 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { if {[$w info anchor] == ""} { $w anchor set $ent $w see $ent } if {[$w selection includes $ent]} { $w selection clear $ent } else { $w selection set $ent } tixTList:CallBrowseCmd $w $ent } tixTList:GoState e2 $w } proc tixTList:GoState-xm7 {w x y} { set ent [$w nearest $x $y] if {$ent != ""} { $w selection clear $w selection set $ent tixTList:CallCommand $w $ent } tixTList:GoState e0 $w } #---------------------------------------------------------------------- # callback actions #---------------------------------------------------------------------- proc tixTList:SetAnchor {w x y} { set ent [$w nearest $x $y] if {$ent != "" && [$w entrycget $ent -state] != "disabled"} { $w anchor set $ent $w see $ent return $ent } return "" } proc tixTList:Select {w ent} { $w selection clear $w select set $ent } proc tixTList:StartScan {w} { global tkPriv set tkPriv(afterId) [after 50 tixTList:AutoScan $w] } proc tixTList:DoScan {w} { global tkPriv set x $tkPriv(x) set y $tkPriv(y) set X $tkPriv(X) set Y $tkPriv(Y) set out 0 if {$y >= [winfo height $w]} { $w yview scroll 1 units set out 1 } if {$y < 0} { $w yview scroll -1 units set out 1 } if {$x >= [winfo width $w]} { $w xview scroll 2 units set out 1 } if {$x < 0} { $w xview scroll -2 units set out 1 } if {$out} { set tkPriv(afterId) [after 50 tixTList:AutoScan $w] } } proc tixTList:CallBrowseCmd {w ent} { set browsecmd [$w cget -browsecmd] if {$browsecmd != ""} { set bind(specs) {%V} set bind(%V) $ent tixEvalCmdBinding $w $browsecmd bind $ent } } proc tixTList:CallCommand {w ent} { set command [$w cget -command] if {$command != ""} { set bind(specs) {%V} set bind(%V) $ent tixEvalCmdBinding $w $command bind $ent } }