URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [HList.tcl] - Blame information for rev 1765

Details | Compare with Previous | View Log


# HList.tcl --
#
#       This file defines the default bindings for Tix Hierarchical Listbox
#       widgets.
#
# Copyright (c) 1996, Expert Interface Technologies
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
 
 
 
#--------------------------------------------------------------------------
# tkPriv elements used in this file:
#
# afterId -             Token returned by "after" for autoscanning.
# fakeRelease -         Cancel the ButtonRelease-1 after the user double click
#--------------------------------------------------------------------------
#
proc tixHListBind {} {
    tixBind TixHList <ButtonPress-1> {
        tixHList:Button-1 %W %x %y ""
    }
    tixBind TixHList <Shift-ButtonPress-1> {
        tixHList:Button-1 %W %x %y s
    }
    tixBind TixHList <Control-ButtonPress-1> {
        tixHList:Button-1 %W %x %y c
    }
    tixBind TixHList <ButtonRelease-1> {
        tixHList:ButtonRelease-1 %W %x %y
    }
    tixBind TixHList <Double-ButtonPress-1> {
        tixHList:Double-1 %W  %x %y
    }
    tixBind TixHList <B1-Motion> {
        set tkPriv(x) %x
        set tkPriv(y) %y
        set tkPriv(X) %X
        set tkPriv(Y) %Y
 
        tixHList:B1-Motion %W %x %y
    }
    tixBind TixHList <B1-Leave> {
        set tkPriv(x) %x
        set tkPriv(y) %y
        set tkPriv(X) %X
        set tkPriv(Y) %Y
 
        tixHList:B1-Leave %W
    }
    tixBind TixHList <B1-Enter> {
        tixHList:B1-Enter %W %x %y
    }
 
    # Keyboard bindings
    #
    tixBind TixHList <Up> {
        tixHList:UpDown %W prev ""
    }
    tixBind TixHList <Down> {
        tixHList:UpDown %W next ""
    }
    tixBind TixHList <Shift-Up> {
        tixHList:UpDown %W prev s
    }
    tixBind TixHList <Shift-Down> {
        tixHList:UpDown %W next s
    }
    tixBind TixHList <Left> {
        tixHList:LeftRight %W left
    }
    tixBind TixHList <Right> {
        tixHList:LeftRight %W right
    }
    tixBind TixHList <Prior> {
        %W yview scroll -1 pages
    }
    tixBind TixHList <Next> {
        %W yview scroll 1 pages
    }
    tixBind TixHList <Return> {
        tixHList:Keyboard-Activate %W
    }
    tixBind TixHList <space> {
        tixHList:Keyboard-Browse %W
    }
}
 
#----------------------------------------------------------------------
#
#
#                        Key bindings
#
#
#----------------------------------------------------------------------
proc tixHList:Keyboard-Activate {w} {
    if {[tixHList:GetState $w] != 0} {
        return
    }
    set ent [$w info anchor]
 
    if {$ent == ""} {
        return
    }
 
    if {[$w cget -selectmode] == "single"} {
        $w select clear
        $w select set $ent
    }
 
    set command [$w cget -command]
    if {$command != ""} {
        set bind(specs) {%V}
        set bind(%V)    $ent
 
        tixEvalCmdBinding $w $command bind $ent
    }
}
 
proc tixHList:Keyboard-Browse {w} {
    if {[tixHList:GetState $w] != 0} {
        return
    }
    set ent [$w info anchor]
 
    if {$ent == ""} {
        return
    }
 
    if {[$w cget -selectmode] == "single"} {
        $w select clear
        $w select set $ent
    }
 
    tixHList:Browse $w $ent
}
 
proc tixHList:LeftRight {w spec} {
    catch {
        uplevel #0 unset $w:priv:shiftanchor
    }
    if {[tixHList:GetState $w] != 0} {
        return
    }
 
    set anchor [$w info anchor]
    if {$anchor == ""} {
        set anchor [lindex [$w info children] 0]
    }
    if {$anchor == ""} {
        return
    }
 
    set ent $anchor
    while {1} {
        set e $ent
        if {$spec == "left"} {
            set ent [$w info parent $e]
 
            if {$ent == "" || [$w entrycget $ent -state] == "disabled"} {
                set ent [$w info prev $e]
            }
        } else {
            set ent [lindex [$w info children $e] 0]
 
            if {$ent == "" || [$w entrycget $ent -state] == "disabled"} {
                set ent [$w info next $e]
            }
        }
 
        if {$ent == ""} {
            break
        }
        if {[$w entrycget $ent -state] == "disabled"} {
            continue
        }
        if [$w info hidden $ent] {
            continue
        }
        break
    }
 
    if {$ent == ""} {
       return
    }
 
    $w anchor set $ent
    $w see $ent
 
    if {[$w cget -selectmode] != "single"} {
        $w select clear
        $w selection set $ent
 
        tixHList:Browse $w $ent
    }
}
 
proc tixHList:UpDown {w spec mod} {
    if {[tixHList:GetState $w] != 0} {
        return
    }
    set anchor [$w info anchor]
    set done 0
 
    if {$anchor == ""} {
        set anchor [lindex [$w info children] 0]
 
        if {$anchor == ""} {
            return
        }
 
        if {[$w entrycget $anchor -state] != "disabled"} {
            # That's a good anchor
            set done 1
        } else {
            # We search for the first non-disabled entry (downward)
            set spec next
        }
    }
 
    set ent $anchor
    # Find the prev/next non-disabled entry
    #
    while {!$done} {
        set ent [$w info $spec $ent]
        if {$ent == ""} {
            break
        }
        if {[$w entrycget $ent -state] == "disabled"} {
            continue
        }
        if [$w info hidden $ent] {
            continue
        }
        break
    }
 
    if {$ent == ""} {
        return
    } else {
        $w see $ent
        $w anchor set $ent
 
        set selMode [$w cget -selectmode]
       if {$mod == "s" && ($selMode == "extended" || $selMode == "multiple")} {
            global $w:priv:shiftanchor
 
            if ![info exists $w:priv:shiftanchor] {
                set $w:priv:shiftanchor $anchor
            }
 
            $w selection clear
            $w selection set $ent [set $w:priv:shiftanchor]
 
            tixHList:Browse $w $ent
        } else {
            catch {
                uplevel #0 unset $w:priv:shiftanchor
            }
 
            if {[$w cget -selectmode] != "single"} {
                $w select clear
                $w selection set $ent
 
                tixHList:Browse $w $ent
            }
        }
    }
}
 
#----------------------------------------------------------------------
#
#
#                        Mouse bindings
#
#
#----------------------------------------------------------------------
 
proc tixHList:Button-1 {w x y mod} {
#    if {[$w cget -state] == "disabled"} {
#       return
#    }
 
    if [$w cget -takefocus] {
        focus $w
    }
 
    set selMode [$w cget -selectmode]
 
    case [tixHList:GetState $w] {
        {0} {
            if {$mod == "s" && $selMode == "multiple"} {
                tixHList:GoState 28 $w $x $y
                return
            }
            if {$mod == "s" && $selMode == "extended"} {
                tixHList:GoState 28 $w $x $y
                return
            }
            if {$mod == "c" && $selMode == "extended"} {
                tixHList:GoState 33 $w $x $y
                return
            }
 
            tixHList:GoState 1 $w $x $y
        }
    }
}
 
proc tixHList:ButtonRelease-1 {w x y} {
    case [tixHList:GetState $w] {
        {5 16} {
            tixHList:GoState 6 $w $x $y
        }
        {15} {
            tixHList:GoState 17 $w $x $y
        }
        {10 11} {
            tixHList:GoState 18 $w
        }
        {13 20} {
            tixHList:GoState 14 $w $x $y
        }
        {21} {
            tixHList:GoState 22 $w
        }
        {24} {
            tixHList:GoState 25 $w
        }
        {26 28 33} {
            tixHList:GoState 27 $w
        }
        {30} {
            tixHList:GoState 32 $w
        }
    }
}
 
proc tixHList:Double-1 {w x y} {
    case [tixHList:GetState $w] {
        {0} {
            tixHList:GoState 23 $w $x $y
        }
    }
}
 
proc tixHList:B1-Motion {w x y} {
    case [tixHList:GetState $w] {
        {1} {
            tixHList:GoState 5 $w $x $y
        }
        {5 16} {
            tixHList:GoState 5 $w $x $y
        }
        {13 20 21} {
            tixHList:GoState 20 $w $x $y
        }
        {24 26 28} {
            tixHList:GoState 26 $w $x $y
        }
    }
}
 
proc tixHList:B1-Leave {w} {
    case [tixHList:GetState $w] {
        {5} {
            tixHList:GoState 10 $w
        }
        {26} {
            tixHList:GoState 29 $w
        }
    }
}
 
proc tixHList:B1-Enter {w x y} {
    case [tixHList:GetState $w] {
        {10 11} {
            tixHList:GoState 12 $w $x $y
        }
        {29 30} {
            tixHList:GoState 31 $w $x $y
        }
    }
}
 
proc tixHList:AutoScan {w} {
    case [tixHList:GetState $w] {
        {29 30} {
            tixHList:GoState 30 $w
        }
    }
}
 
#----------------------------------------------------------------------
#
#                       STATE MANIPULATION
#
#
#----------------------------------------------------------------------
proc tixHList:GetState {w} {
    global $w:priv:state
 
    if {![info exists $w:priv:state]} {
        set $w:priv:state 0
    }
    return [set $w:priv:state]
}
 
proc tixHList:SetState {w n} {
    global $w:priv:state
 
    set $w:priv:state $n
}
 
proc tixHList:GoState {n w args} {
 
#   puts "going from [tixHList:GetState $w] --> $n"
 
    tixHList:SetState $w $n
    eval tixHList:GoState-$n $w $args
}
 
#----------------------------------------------------------------------
#                       States
#----------------------------------------------------------------------
proc tixHList:GoState-0 {w} {
 
}
proc tixHList:GoState-1 {w x y} {
    set oldEnt [$w info anchor]
    set ent [tixHList:SetAnchor $w $x $y 1]
 
    if {$ent == ""} {
        tixHList:GoState 0 $w
        return
    }
 
    set info [$w info item $x $y]
    if {[lindex $info 1] == "indicator"} {
        tixHList:GoState 13 $w $ent $oldEnt
    } else {
        if {[$w entrycget $ent -state] == "disabled"} {
            tixHList:GoState 0 $w
        } else {
            case [$w cget -selectmode] {
                {single browse} {
                    tixHList:GoState 16 $w $ent
                }
                default {
                    tixHList:GoState 24 $w $ent
                }
            }
        }
    }
}
 
proc tixHList:GoState-5 {w x y} {
    set oldEnt [$w info anchor]
 
    set ent [tixHList:SetAnchor $w $x $y]
 
    if {$ent == "" || $oldEnt == $ent} {
        return
    }
 
    if {[$w cget -selectmode] != "single"} {
        tixHList:Select $w $ent
        tixHList:Browse $w $ent
    }
}
 
proc tixHList:GoState-6 {w x y} {
    set ent [tixHList:SetAnchor $w $x $y]
 
    if {$ent == ""} {
        tixHList:GoState 0 $w
        return
    }
    tixHList:Select $w $ent
    tixHList:Browse $w $ent
 
    tixHList:GoState 0 $w
}
 
proc tixHList:GoState-10 {w} {
    tixHList:StartScan $w
}
 
proc tixHList:GoState-11 {w} {
    global tkPriv
 
    tixHList:DoScan $w
 
    set oldEnt [$w info anchor]
    set ent [tixHList:SetAnchor $w $tkPriv(x) $tkPriv(y)]
 
    if {$ent == "" || $oldEnt == $ent} {
        return
    }
 
    if {[$w cget -selectmode] != "single"} {
        tixHList:Select $w $ent
        tixHList:Browse $w $ent
    }
}
 
proc tixHList:GoState-12 {w x y} {
    tkCancelRepeat
    tixHList:GoState 5 $w $x $y
}
 
proc tixHList:GoState-13 {w ent oldEnt} {
    global tkPriv
    set tkPriv(tix,indicator) $ent
    set tkPriv(tix,oldEnt)    $oldEnt
    tixHList:CallIndicatorCmd $w <Arm> $ent
}
 
proc tixHList:GoState-14 {w x y} {
    global tkPriv
 
    if [tixHList:InsideArmedIndicator $w $x $y] {
        $w anchor set $tkPriv(tix,indicator)
        $w select clear
        $w select set $tkPriv(tix,indicator)
        tixHList:CallIndicatorCmd $w <Activate> $tkPriv(tix,indicator)
    } else {
        tixHList:CallIndicatorCmd $w <Disarm>   $tkPriv(tix,indicator)
    }
 
    unset tkPriv(tix,indicator)
    tixHList:GoState 0 $w
}
 
proc tixHList:GoState-16 {w ent} {
    if {$ent != "" && [$w cget -selectmode] != "single"} {
        tixHList:Select $w $ent
        tixHList:Browse $w $ent
    }
}
 
proc tixHList:GoState-18 {w} {
    global tkPriv
    tkCancelRepeat
    tixHList:GoState 6 $w $tkPriv(x) $tkPriv(y)
}
 
proc tixHList:GoState-20 {w x y} {
    global tkPriv
 
    if {![tixHList:InsideArmedIndicator $w $x $y]} {
        tixHList:GoState 21 $w $x $y
    } else {
        tixHList:CallIndicatorCmd $w <Arm> $tkPriv(tix,indicator)
    }
}
 
proc tixHList:GoState-21 {w x y} {
    global tkPriv
 
    if {[tixHList:InsideArmedIndicator $w $x $y]} {
        tixHList:GoState 20 $w $x $y
    } else {
        tixHList:CallIndicatorCmd $w <Disarm> $tkPriv(tix,indicator)
    }
}
 
proc tixHList:GoState-22 {w} {
    global tkPriv
 
    if {$tkPriv(tix,oldEnt) != ""} {
        $w anchor set $tkPriv(tix,oldEnt)
    } else {
        $w anchor clear
    }
    tixHList:GoState 0 $w
}
 
proc tixHList:GoState-23 {w x y} {
    set ent [tixHList:GetNearest $w $y]
 
    if {$ent != ""} {
        set info [$w info item $x $y]
 
        if {[lindex $info 1] == "indicator"} {
            tixHList:CallIndicatorCmd $w <Activate> $ent
        } else {
            $w select set $ent
            set command [$w cget -command]
            if {$command != ""} {
                set bind(specs) {%V}
                set bind(%V)    $ent
 
                tixEvalCmdBinding $w $command bind $ent
            }
        }
    }
    tixHList:GoState 0 $w
}
 
proc tixHList:GoState-24 {w ent} {
    if {$ent != ""} {
        tixHList:Select $w $ent
        tixHList:Browse $w $ent
    }
}
 
proc tixHList:GoState-25 {w} {
    set ent [$w info anchor]
 
    if {$ent != ""} {
        tixHList:Select $w $ent
        tixHList:Browse $w $ent
    }
 
    tixHList:GoState 0 $w
}
 
 
proc tixHList:GoState-26 {w x y} {
    set anchor [$w info anchor]
    if {$anchor == ""} {
        set first [lindex [$w info children ""] 0]
        if {$first != ""} {
            $w anchor set $first
            set anchor $first
        } else {
            return
        }
    }
 
    set ent [tixHList:GetNearest $w $y 1]
 
    if {$ent != ""} {
        $w selection clear
        $w selection set $anchor $ent
 
        tixHList:Browse $w $ent
    }
}
 
proc tixHList:GoState-27 {w} {
    set ent [$w info anchor]
 
    if {$ent != ""} {
        tixHList:Browse $w $ent
    }
 
    tixHList:GoState 0 $w
}
 
proc tixHList:GoState-28 {w x y} {
    set anchor [$w info anchor]
    if {$anchor == ""} {
        set first [lindex [$w info children ""] 0]
        if {$first != ""} {
            $w anchor set $first
            set anchor $first
        } else {
            return
        }
    }
 
    set ent [tixHList:GetNearest $w $y 1]
    if {$ent != ""} {
        $w selection clear
        $w selection set $anchor $ent
 
        tixHList:Browse $w $ent
    }
}
 
proc tixHList:GoState-29 {w} {
    tixHList:StartScan $w
}
 
proc tixHList:GoState-30 {w} {
    global tkPriv
 
    tixHList:DoScan $w
 
    set anchor [$w info anchor]
    if {$anchor == ""} {
        set first [lindex [$w info children ""] 0]
        if {$first != ""} {
            $w anchor set $first
            set anchor $first
        } else {
            return
        }
    }
 
    set ent [tixHList:GetNearest $w $tkPriv(y) 1]
    if {$ent != ""} {
        $w selection clear
        $w selection set $anchor $ent
 
        tixHList:Browse $w $ent
    }
}
 
proc tixHList:GoState-31 {w x y} {
    tkCancelRepeat
    tixHList:GoState 26 $w $x $y
}
 
proc tixHList:GoState-32 {w} {
    tkCancelRepeat
    tixHList:GoState 0 $w
}
 
proc tixHList:GoState-33 {w x y} {
    set ent [tixHList:GetNearest $w $y]
    if {$ent != ""} {
        $w anchor set $ent
        $w selection set $ent
        tixHList:Browse $w $ent
    }
}
 
 
#----------------------------------------------------------------------
#
#               Common actions
#
#----------------------------------------------------------------------
proc tixHList:GetNearest {w y {disableOK 0}} {
    set ent [$w nearest $y]
 
    if {$ent != ""} {
        if {!$disableOK && [$w entrycget $ent -state] == "disabled"} {
            return ""
        }
    }
 
    return $ent
}
 
proc tixHList:SetAnchor {w x y {disableOK 0}} {
    set ent [tixHList:GetNearest $w $y $disableOK]
 
    if {$ent != ""} {
        if {[$w entrycget $ent -state] != "disabled"} {
            $w anchor set $ent
            $w see $ent
            return $ent
        } elseif $disableOK {
            return $ent
        }
    }
 
    return ""
}
 
proc tixHList:Select {w ent} {
    if {"x[$w info selection]" != "x$ent"} {
        $w selection clear
        $w select set $ent
    }
}
 
#----------------------------------------------------------------------
#
#                      Auto scan
#
#----------------------------------------------------------------------
proc tixHList:StartScan {w} {
    global tkPriv
    set tkPriv(afterId) [after 50 tixHList:AutoScan $w]
}
 
proc tixHList:DoScan {w} {
    global tkPriv
    set x $tkPriv(x)
    set y $tkPriv(y)
    set X $tkPriv(X)
    set Y $tkPriv(Y)
 
    if {$y >= [winfo height $w]} {
        $w yview scroll 1 units
    } elseif {$y < 0} {
        $w yview scroll -1 units
    } elseif {$x >= [winfo width $w]} {
        $w xview scroll 2 units
    } elseif {$x < 0} {
        $w xview scroll -2 units
    } else {
        return
    }
 
    set tkPriv(afterId) [after 50 tixHList:AutoScan $w]
}
 
 
#----------------------------------------------------------------------
#
#               Indicator handling
#
#----------------------------------------------------------------------
 
proc tixHList:CallIndicatorCmd {w event ent} {
    set cmd [$w cget -indicatorcmd]
 
    if {$cmd != ""} {
        set bind(type)  $event
        set bind(specs) {%V}
        set bind(%V)    $ent
 
        tixEvalCmdBinding $w $cmd bind $ent
    }
}
 
proc tixHList:InsideArmedIndicator {w x y} {
    global tkPriv
 
    set ent [tixHList:GetNearest $w $y 1]
    if {$ent == "" || $ent != $tkPriv(tix,indicator)} {
        return 0
    }
 
    set info [$w info item $x $y]
    if {[lindex $info 1] == "indicator"} {
        return 1
    } else {
        return 0
    }
}
 
proc tixHList:Browse {w ent} {
    set browsecmd [$w cget -browsecmd]
    if {$browsecmd != ""} {
        set bind(specs) {%V}
        set bind(%V)    $ent
 
        tixEvalCmdBinding $w $browsecmd bind $ent
    }
}
 
 

Line No.	Rev	Author	Line
1	578	markom	`# HList.tcl --`
2			`#`
3			`# This file defines the default bindings for Tix Hierarchical Listbox`
4			`# widgets.`
5			`#`
6			`# Copyright (c) 1996, Expert Interface Technologies`
7			`#`
8			`# See the file "license.terms" for information on usage and redistribution`
9			`# of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
10			`#`
11
12
13
14			`#--------------------------------------------------------------------------`
15			`# tkPriv elements used in this file:`
16			`#`
17			`# afterId - Token returned by "after" for autoscanning.`
18			`# fakeRelease - Cancel the ButtonRelease-1 after the user double click`
19			`#--------------------------------------------------------------------------`
20			`#`
21			`proc tixHListBind {} {`
22			`tixBind TixHList <ButtonPress-1> {`
23			`tixHList:Button-1 %W %x %y ""`
24			`}`
25			`tixBind TixHList <Shift-ButtonPress-1> {`
26			`tixHList:Button-1 %W %x %y s`
27			`}`
28			`tixBind TixHList <Control-ButtonPress-1> {`
29			`tixHList:Button-1 %W %x %y c`
30			`}`
31			`tixBind TixHList <ButtonRelease-1> {`
32			`tixHList:ButtonRelease-1 %W %x %y`
33			`}`
34			`tixBind TixHList <Double-ButtonPress-1> {`
35			`tixHList:Double-1 %W %x %y`
36			`}`
37			`tixBind TixHList <B1-Motion> {`
38			`set tkPriv(x) %x`
39			`set tkPriv(y) %y`
40			`set tkPriv(X) %X`
41			`set tkPriv(Y) %Y`
42
43			`tixHList:B1-Motion %W %x %y`
44			`}`
45			`tixBind TixHList <B1-Leave> {`
46			`set tkPriv(x) %x`
47			`set tkPriv(y) %y`
48			`set tkPriv(X) %X`
49			`set tkPriv(Y) %Y`
50
51			`tixHList:B1-Leave %W`
52			`}`
53			`tixBind TixHList <B1-Enter> {`
54			`tixHList:B1-Enter %W %x %y`
55			`}`
56
57			`# Keyboard bindings`
58			`#`
59			`tixBind TixHList <Up> {`
60			`tixHList:UpDown %W prev ""`
61			`}`
62			`tixBind TixHList <Down> {`
63			`tixHList:UpDown %W next ""`
64			`}`
65			`tixBind TixHList <Shift-Up> {`
66			`tixHList:UpDown %W prev s`
67			`}`
68			`tixBind TixHList <Shift-Down> {`
69			`tixHList:UpDown %W next s`
70			`}`
71			`tixBind TixHList <Left> {`
72			`tixHList:LeftRight %W left`
73			`}`
74			`tixBind TixHList <Right> {`
75			`tixHList:LeftRight %W right`
76			`}`
77			`tixBind TixHList <Prior> {`
78			`%W yview scroll -1 pages`
79			`}`
80			`tixBind TixHList <Next> {`
81			`%W yview scroll 1 pages`
82			`}`
83			`tixBind TixHList <Return> {`
84			`tixHList:Keyboard-Activate %W`
85			`}`
86			`tixBind TixHList <space> {`
87			`tixHList:Keyboard-Browse %W`
88			`}`
89			`}`
90
91			`#----------------------------------------------------------------------`
92			`#`
93			`#`
94			`# Key bindings`
95			`#`
96			`#`
97			`#----------------------------------------------------------------------`
98			`proc tixHList:Keyboard-Activate {w} {`
99			`if {[tixHList:GetState $w] != 0} {`
100			`return`
101			`}`
102			`set ent [$w info anchor]`
103
104			`if {$ent == ""} {`
105			`return`
106			`}`
107
108			`if {[$w cget -selectmode] == "single"} {`
109			`$w select clear`
110			`$w select set $ent`
111			`}`
112
113			`set command [$w cget -command]`
114			`if {$command != ""} {`
115			`set bind(specs) {%V}`
116			`set bind(%V) $ent`
117
118			`tixEvalCmdBinding $w $command bind $ent`
119			`}`
120			`}`
121
122			`proc tixHList:Keyboard-Browse {w} {`
123			`if {[tixHList:GetState $w] != 0} {`
124			`return`
125			`}`
126			`set ent [$w info anchor]`
127
128			`if {$ent == ""} {`
129			`return`
130			`}`
131
132			`if {[$w cget -selectmode] == "single"} {`
133			`$w select clear`
134			`$w select set $ent`
135			`}`
136
137			`tixHList:Browse $w $ent`
138			`}`
139
140			`proc tixHList:LeftRight {w spec} {`
141			`catch {`
142			`uplevel #0 unset $w:priv:shiftanchor`
143			`}`
144			`if {[tixHList:GetState $w] != 0} {`
145			`return`
146			`}`
147
148			`set anchor [$w info anchor]`
149			`if {$anchor == ""} {`
150			`set anchor [lindex [$w info children] 0]`
151			`}`
152			`if {$anchor == ""} {`
153			`return`
154			`}`
155
156			`set ent $anchor`
157			`while {1} {`
158			`set e $ent`
159			`if {$spec == "left"} {`
160			`set ent [$w info parent $e]`
161
162			`if {$ent == "" \|\| [$w entrycget $ent -state] == "disabled"} {`
163			`set ent [$w info prev $e]`
164			`}`
165			`} else {`
166			`set ent [lindex [$w info children $e] 0]`
167
168			`if {$ent == "" \|\| [$w entrycget $ent -state] == "disabled"} {`
169			`set ent [$w info next $e]`
170			`}`
171			`}`
172
173			`if {$ent == ""} {`
174			`break`
175			`}`
176			`if {[$w entrycget $ent -state] == "disabled"} {`
177			`continue`
178			`}`
179			`if [$w info hidden $ent] {`
180			`continue`
181			`}`
182			`break`
183			`}`
184
185			`if {$ent == ""} {`
186			`return`
187			`}`
188
189			`$w anchor set $ent`
190			`$w see $ent`
191
192			`if {[$w cget -selectmode] != "single"} {`
193			`$w select clear`
194			`$w selection set $ent`
195
196			`tixHList:Browse $w $ent`
197			`}`
198			`}`
199
200			`proc tixHList:UpDown {w spec mod} {`
201			`if {[tixHList:GetState $w] != 0} {`
202			`return`
203			`}`
204			`set anchor [$w info anchor]`
205			`set done 0`
206
207			`if {$anchor == ""} {`
208			`set anchor [lindex [$w info children] 0]`
209
210			`if {$anchor == ""} {`
211			`return`
212			`}`
213
214			`if {[$w entrycget $anchor -state] != "disabled"} {`
215			`# That's a good anchor`
216			`set done 1`
217			`} else {`
218			`# We search for the first non-disabled entry (downward)`
219			`set spec next`
220			`}`
221			`}`
222
223			`set ent $anchor`
224			`# Find the prev/next non-disabled entry`
225			`#`
226			`while {!$done} {`
227			`set ent [$w info $spec $ent]`
228			`if {$ent == ""} {`
229			`break`
230			`}`
231			`if {[$w entrycget $ent -state] == "disabled"} {`
232			`continue`
233			`}`
234			`if [$w info hidden $ent] {`
235			`continue`
236			`}`
237			`break`
238			`}`
239
240			`if {$ent == ""} {`
241			`return`
242			`} else {`
243			`$w see $ent`
244			`$w anchor set $ent`
245
246			`set selMode [$w cget -selectmode]`
247			`if {$mod == "s" && ($selMode == "extended" \|\| $selMode == "multiple")} {`
248			`global $w:priv:shiftanchor`
249
250			`if ![info exists $w:priv:shiftanchor] {`
251			`set $w:priv:shiftanchor $anchor`
252			`}`
253
254			`$w selection clear`
255			`$w selection set $ent [set $w:priv:shiftanchor]`
256
257			`tixHList:Browse $w $ent`
258			`} else {`
259			`catch {`
260			`uplevel #0 unset $w:priv:shiftanchor`
261			`}`
262
263			`if {[$w cget -selectmode] != "single"} {`
264			`$w select clear`
265			`$w selection set $ent`
266
267			`tixHList:Browse $w $ent`
268			`}`
269			`}`
270			`}`
271			`}`
272
273			`#----------------------------------------------------------------------`
274			`#`
275			`#`
276			`# Mouse bindings`
277			`#`
278			`#`
279			`#----------------------------------------------------------------------`
280
281			`proc tixHList:Button-1 {w x y mod} {`
282			`# if {[$w cget -state] == "disabled"} {`
283			`# return`
284			`# }`
285
286			`if [$w cget -takefocus] {`
287			`focus $w`
288			`}`
289
290			`set selMode [$w cget -selectmode]`
291
292			`case [tixHList:GetState $w] {`
293			`{0} {`
294			`if {$mod == "s" && $selMode == "multiple"} {`
295			`tixHList:GoState 28 $w $x $y`
296			`return`
297			`}`
298			`if {$mod == "s" && $selMode == "extended"} {`
299			`tixHList:GoState 28 $w $x $y`
300			`return`
301			`}`
302			`if {$mod == "c" && $selMode == "extended"} {`
303			`tixHList:GoState 33 $w $x $y`
304			`return`
305			`}`
306
307			`tixHList:GoState 1 $w $x $y`
308			`}`
309			`}`
310			`}`
311
312			`proc tixHList:ButtonRelease-1 {w x y} {`
313			`case [tixHList:GetState $w] {`
314			`{5 16} {`
315			`tixHList:GoState 6 $w $x $y`
316			`}`
317			`{15} {`
318			`tixHList:GoState 17 $w $x $y`
319			`}`
320			`{10 11} {`
321			`tixHList:GoState 18 $w`
322			`}`
323			`{13 20} {`
324			`tixHList:GoState 14 $w $x $y`
325			`}`
326			`{21} {`
327			`tixHList:GoState 22 $w`
328			`}`
329			`{24} {`
330			`tixHList:GoState 25 $w`
331			`}`
332			`{26 28 33} {`
333			`tixHList:GoState 27 $w`
334			`}`
335			`{30} {`
336			`tixHList:GoState 32 $w`
337			`}`
338			`}`
339			`}`
340
341			`proc tixHList:Double-1 {w x y} {`
342			`case [tixHList:GetState $w] {`
343			`{0} {`
344			`tixHList:GoState 23 $w $x $y`
345			`}`
346			`}`
347			`}`
348
349			`proc tixHList:B1-Motion {w x y} {`
350			`case [tixHList:GetState $w] {`
351			`{1} {`
352			`tixHList:GoState 5 $w $x $y`
353			`}`
354			`{5 16} {`
355			`tixHList:GoState 5 $w $x $y`
356			`}`
357			`{13 20 21} {`
358			`tixHList:GoState 20 $w $x $y`
359			`}`
360			`{24 26 28} {`
361			`tixHList:GoState 26 $w $x $y`
362			`}`
363			`}`
364			`}`
365
366			`proc tixHList:B1-Leave {w} {`
367			`case [tixHList:GetState $w] {`
368			`{5} {`
369			`tixHList:GoState 10 $w`
370			`}`
371			`{26} {`
372			`tixHList:GoState 29 $w`
373			`}`
374			`}`
375			`}`
376
377			`proc tixHList:B1-Enter {w x y} {`
378			`case [tixHList:GetState $w] {`
379			`{10 11} {`
380			`tixHList:GoState 12 $w $x $y`
381			`}`
382			`{29 30} {`
383			`tixHList:GoState 31 $w $x $y`
384			`}`
385			`}`
386			`}`
387
388			`proc tixHList:AutoScan {w} {`
389			`case [tixHList:GetState $w] {`
390			`{29 30} {`
391			`tixHList:GoState 30 $w`
392			`}`
393			`}`
394			`}`
395
396			`#----------------------------------------------------------------------`
397			`#`
398			`# STATE MANIPULATION`
399			`#`
400			`#`
401			`#----------------------------------------------------------------------`
402			`proc tixHList:GetState {w} {`
403			`global $w:priv:state`
404
405			`if {![info exists $w:priv:state]} {`
406			`set $w:priv:state 0`
407			`}`
408			`return [set $w:priv:state]`
409			`}`
410
411			`proc tixHList:SetState {w n} {`
412			`global $w:priv:state`
413
414			`set $w:priv:state $n`
415			`}`
416
417			`proc tixHList:GoState {n w args} {`
418
419			`# puts "going from [tixHList:GetState $w] --> $n"`
420
421			`tixHList:SetState $w $n`
422			`eval tixHList:GoState-$n $w $args`
423			`}`
424
425			`#----------------------------------------------------------------------`
426			`# States`
427			`#----------------------------------------------------------------------`
428			`proc tixHList:GoState-0 {w} {`
429
430			`}`
431			`proc tixHList:GoState-1 {w x y} {`
432			`set oldEnt [$w info anchor]`
433			`set ent [tixHList:SetAnchor $w $x $y 1]`
434
435			`if {$ent == ""} {`
436			`tixHList:GoState 0 $w`
437			`return`
438			`}`
439
440			`set info [$w info item $x $y]`
441			`if {[lindex $info 1] == "indicator"} {`
442			`tixHList:GoState 13 $w $ent $oldEnt`
443			`} else {`
444			`if {[$w entrycget $ent -state] == "disabled"} {`
445			`tixHList:GoState 0 $w`
446			`} else {`
447			`case [$w cget -selectmode] {`
448			`{single browse} {`
449			`tixHList:GoState 16 $w $ent`
450			`}`
451			`default {`
452			`tixHList:GoState 24 $w $ent`
453			`}`
454			`}`
455			`}`
456			`}`
457			`}`
458
459			`proc tixHList:GoState-5 {w x y} {`
460			`set oldEnt [$w info anchor]`
461
462			`set ent [tixHList:SetAnchor $w $x $y]`
463
464			`if {$ent == "" \|\| $oldEnt == $ent} {`
465			`return`
466			`}`
467
468			`if {[$w cget -selectmode] != "single"} {`
469			`tixHList:Select $w $ent`
470			`tixHList:Browse $w $ent`
471			`}`
472			`}`
473
474			`proc tixHList:GoState-6 {w x y} {`
475			`set ent [tixHList:SetAnchor $w $x $y]`
476
477			`if {$ent == ""} {`
478			`tixHList:GoState 0 $w`
479			`return`
480			`}`
481			`tixHList:Select $w $ent`
482			`tixHList:Browse $w $ent`
483
484			`tixHList:GoState 0 $w`
485			`}`
486
487			`proc tixHList:GoState-10 {w} {`
488			`tixHList:StartScan $w`
489			`}`
490
491			`proc tixHList:GoState-11 {w} {`
492			`global tkPriv`
493
494			`tixHList:DoScan $w`
495
496			`set oldEnt [$w info anchor]`
497			`set ent [tixHList:SetAnchor $w $tkPriv(x) $tkPriv(y)]`
498
499			`if {$ent == "" \|\| $oldEnt == $ent} {`
500			`return`
501			`}`
502
503			`if {[$w cget -selectmode] != "single"} {`
504			`tixHList:Select $w $ent`
505			`tixHList:Browse $w $ent`
506			`}`
507			`}`
508
509			`proc tixHList:GoState-12 {w x y} {`
510			`tkCancelRepeat`
511			`tixHList:GoState 5 $w $x $y`
512			`}`
513
514			`proc tixHList:GoState-13 {w ent oldEnt} {`
515			`global tkPriv`
516			`set tkPriv(tix,indicator) $ent`
517			`set tkPriv(tix,oldEnt) $oldEnt`
518			`tixHList:CallIndicatorCmd $w <Arm> $ent`
519			`}`
520
521			`proc tixHList:GoState-14 {w x y} {`
522			`global tkPriv`
523
524			`if [tixHList:InsideArmedIndicator $w $x $y] {`
525			`$w anchor set $tkPriv(tix,indicator)`
526			`$w select clear`
527			`$w select set $tkPriv(tix,indicator)`
528			`tixHList:CallIndicatorCmd $w <Activate> $tkPriv(tix,indicator)`
529			`} else {`
530			`tixHList:CallIndicatorCmd $w <Disarm> $tkPriv(tix,indicator)`
531			`}`
532
533			`unset tkPriv(tix,indicator)`
534			`tixHList:GoState 0 $w`
535			`}`
536
537			`proc tixHList:GoState-16 {w ent} {`
538			`if {$ent != "" && [$w cget -selectmode] != "single"} {`
539			`tixHList:Select $w $ent`
540			`tixHList:Browse $w $ent`
541			`}`
542			`}`
543
544			`proc tixHList:GoState-18 {w} {`
545			`global tkPriv`
546			`tkCancelRepeat`
547			`tixHList:GoState 6 $w $tkPriv(x) $tkPriv(y)`
548			`}`
549
550			`proc tixHList:GoState-20 {w x y} {`
551			`global tkPriv`
552
553			`if {![tixHList:InsideArmedIndicator $w $x $y]} {`
554			`tixHList:GoState 21 $w $x $y`
555			`} else {`
556			`tixHList:CallIndicatorCmd $w <Arm> $tkPriv(tix,indicator)`
557			`}`
558			`}`
559
560			`proc tixHList:GoState-21 {w x y} {`
561			`global tkPriv`
562
563			`if {[tixHList:InsideArmedIndicator $w $x $y]} {`
564			`tixHList:GoState 20 $w $x $y`
565			`} else {`
566			`tixHList:CallIndicatorCmd $w <Disarm> $tkPriv(tix,indicator)`
567			`}`
568			`}`
569
570			`proc tixHList:GoState-22 {w} {`
571			`global tkPriv`
572
573			`if {$tkPriv(tix,oldEnt) != ""} {`
574			`$w anchor set $tkPriv(tix,oldEnt)`
575			`} else {`
576			`$w anchor clear`
577			`}`
578			`tixHList:GoState 0 $w`
579			`}`
580
581			`proc tixHList:GoState-23 {w x y} {`
582			`set ent [tixHList:GetNearest $w $y]`
583
584			`if {$ent != ""} {`
585			`set info [$w info item $x $y]`
586
587			`if {[lindex $info 1] == "indicator"} {`
588			`tixHList:CallIndicatorCmd $w <Activate> $ent`
589			`} else {`
590			`$w select set $ent`
591			`set command [$w cget -command]`
592			`if {$command != ""} {`
593			`set bind(specs) {%V}`
594			`set bind(%V) $ent`
595
596			`tixEvalCmdBinding $w $command bind $ent`
597			`}`
598			`}`
599			`}`
600			`tixHList:GoState 0 $w`
601			`}`
602
603			`proc tixHList:GoState-24 {w ent} {`
604			`if {$ent != ""} {`
605			`tixHList:Select $w $ent`
606			`tixHList:Browse $w $ent`
607			`}`
608			`}`
609
610			`proc tixHList:GoState-25 {w} {`
611			`set ent [$w info anchor]`
612
613			`if {$ent != ""} {`
614			`tixHList:Select $w $ent`
615			`tixHList:Browse $w $ent`
616			`}`
617
618			`tixHList:GoState 0 $w`
619			`}`
620
621
622			`proc tixHList:GoState-26 {w x y} {`
623			`set anchor [$w info anchor]`
624			`if {$anchor == ""} {`
625			`set first [lindex [$w info children ""] 0]`
626			`if {$first != ""} {`
627			`$w anchor set $first`
628			`set anchor $first`
629			`} else {`
630			`return`
631			`}`
632			`}`
633
634			`set ent [tixHList:GetNearest $w $y 1]`
635
636			`if {$ent != ""} {`
637			`$w selection clear`
638			`$w selection set $anchor $ent`
639
640			`tixHList:Browse $w $ent`
641			`}`
642			`}`
643
644			`proc tixHList:GoState-27 {w} {`
645			`set ent [$w info anchor]`
646
647			`if {$ent != ""} {`
648			`tixHList:Browse $w $ent`
649			`}`
650
651			`tixHList:GoState 0 $w`
652			`}`
653
654			`proc tixHList:GoState-28 {w x y} {`
655			`set anchor [$w info anchor]`
656			`if {$anchor == ""} {`
657			`set first [lindex [$w info children ""] 0]`
658			`if {$first != ""} {`
659			`$w anchor set $first`
660			`set anchor $first`
661			`} else {`
662			`return`
663			`}`
664			`}`
665
666			`set ent [tixHList:GetNearest $w $y 1]`
667			`if {$ent != ""} {`
668			`$w selection clear`
669			`$w selection set $anchor $ent`
670
671			`tixHList:Browse $w $ent`
672			`}`
673			`}`
674
675			`proc tixHList:GoState-29 {w} {`
676			`tixHList:StartScan $w`
677			`}`
678
679			`proc tixHList:GoState-30 {w} {`
680			`global tkPriv`
681
682			`tixHList:DoScan $w`
683
684			`set anchor [$w info anchor]`
685			`if {$anchor == ""} {`
686			`set first [lindex [$w info children ""] 0]`
687			`if {$first != ""} {`
688			`$w anchor set $first`
689			`set anchor $first`
690			`} else {`
691			`return`
692			`}`
693			`}`
694
695			`set ent [tixHList:GetNearest $w $tkPriv(y) 1]`
696			`if {$ent != ""} {`
697			`$w selection clear`
698			`$w selection set $anchor $ent`
699
700			`tixHList:Browse $w $ent`
701			`}`
702			`}`
703
704			`proc tixHList:GoState-31 {w x y} {`
705			`tkCancelRepeat`
706			`tixHList:GoState 26 $w $x $y`
707			`}`
708
709			`proc tixHList:GoState-32 {w} {`
710			`tkCancelRepeat`
711			`tixHList:GoState 0 $w`
712			`}`
713
714			`proc tixHList:GoState-33 {w x y} {`
715			`set ent [tixHList:GetNearest $w $y]`
716			`if {$ent != ""} {`
717			`$w anchor set $ent`
718			`$w selection set $ent`
719			`tixHList:Browse $w $ent`
720			`}`
721			`}`
722
723
724			`#----------------------------------------------------------------------`
725			`#`
726			`# Common actions`
727			`#`
728			`#----------------------------------------------------------------------`
729			`proc tixHList:GetNearest {w y {disableOK 0}} {`
730			`set ent [$w nearest $y]`
731
732			`if {$ent != ""} {`
733			`if {!$disableOK && [$w entrycget $ent -state] == "disabled"} {`
734			`return ""`
735			`}`
736			`}`
737
738			`return $ent`
739			`}`
740
741			`proc tixHList:SetAnchor {w x y {disableOK 0}} {`
742			`set ent [tixHList:GetNearest $w $y $disableOK]`
743
744			`if {$ent != ""} {`
745			`if {[$w entrycget $ent -state] != "disabled"} {`
746			`$w anchor set $ent`
747			`$w see $ent`
748			`return $ent`
749			`} elseif $disableOK {`
750			`return $ent`
751			`}`
752			`}`
753
754			`return ""`
755			`}`
756
757			`proc tixHList:Select {w ent} {`
758			`if {"x[$w info selection]" != "x$ent"} {`
759			`$w selection clear`
760			`$w select set $ent`
761			`}`
762			`}`
763
764			`#----------------------------------------------------------------------`
765			`#`
766			`# Auto scan`
767			`#`
768			`#----------------------------------------------------------------------`
769			`proc tixHList:StartScan {w} {`
770			`global tkPriv`
771			`set tkPriv(afterId) [after 50 tixHList:AutoScan $w]`
772			`}`
773
774			`proc tixHList:DoScan {w} {`
775			`global tkPriv`
776			`set x $tkPriv(x)`
777			`set y $tkPriv(y)`
778			`set X $tkPriv(X)`
779			`set Y $tkPriv(Y)`
780
781			`if {$y >= [winfo height $w]} {`
782			`$w yview scroll 1 units`
783			`} elseif {$y < 0} {`
784			`$w yview scroll -1 units`
785			`} elseif {$x >= [winfo width $w]} {`
786			`$w xview scroll 2 units`
787			`} elseif {$x < 0} {`
788			`$w xview scroll -2 units`
789			`} else {`
790			`return`
791			`}`
792
793			`set tkPriv(afterId) [after 50 tixHList:AutoScan $w]`
794			`}`
795
796
797			`#----------------------------------------------------------------------`
798			`#`
799			`# Indicator handling`
800			`#`
801			`#----------------------------------------------------------------------`
802
803			`proc tixHList:CallIndicatorCmd {w event ent} {`
804			`set cmd [$w cget -indicatorcmd]`
805
806			`if {$cmd != ""} {`
807			`set bind(type) $event`
808			`set bind(specs) {%V}`
809			`set bind(%V) $ent`
810
811			`tixEvalCmdBinding $w $cmd bind $ent`
812			`}`
813			`}`
814
815			`proc tixHList:InsideArmedIndicator {w x y} {`
816			`global tkPriv`
817
818			`set ent [tixHList:GetNearest $w $y 1]`
819			`if {$ent == "" \|\| $ent != $tkPriv(tix,indicator)} {`
820			`return 0`
821			`}`
822
823			`set info [$w info item $x $y]`
824			`if {[lindex $info 1] == "indicator"} {`
825			`return 1`
826			`} else {`
827			`return 0`
828			`}`
829			`}`
830
831			`proc tixHList:Browse {w ent} {`
832			`set browsecmd [$w cget -browsecmd]`
833			`if {$browsecmd != ""} {`
834			`set bind(specs) {%V}`
835			`set bind(%V) $ent`
836
837			`tixEvalCmdBinding $w $browsecmd bind $ent`
838			`}`
839			`}`
840
841

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [HList.tcl] - Blame information for rev 1765