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

Subversion Repositories or1k

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

Details | Compare with Previous | View Log


# VTree.tcl --
#
#       Virtual base class for Tree 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.
#
 
tixWidgetClass tixVTree {
    -virtual true
    -classname TixVTree
    -superclass tixScrolledHList
    -method {
    }
    -flag {
        -ignoreinvoke
    }
    -configspec {
        {-ignoreinvoke ignoreInvoke IgnoreInvoke false tixVerifyBoolean}
    }
    -default {
    }
}
 
proc tixVTree:InitWidgetRec {w} {
    upvar #0 $w data
 
    tixChainMethod $w InitWidgetRec
}
 
proc tixVTree:ConstructWidget {w} {
    upvar #0 $w data
 
    tixChainMethod $w ConstructWidget
 
    set data(indStyle) [tixDisplayStyle image -refwindow $data(w:hlist) \
        -padx 0 -pady 0]
}
 
proc tixVTree:SetBindings {w} {
    upvar #0 $w data
 
    tixChainMethod $w SetBindings
 
    $data(w:hlist) config \
        -indicatorcmd "tixVTree:IndicatorCmd $w" \
        -browsecmd "tixVTree:BrowseCmdHook $w"\
        -command "tixVTree:CommandHook $w"
}
 
proc tixVTree:IndicatorCmd {w args} {
    upvar #0 $w data
 
    uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
    set event [tixEvent type]
    set ent   [tixEvent flag V]
 
    set type [tixVTree:GetType $w $ent]
    set plus     [tix getimage plus]
    set plusarm  [tix getimage plusarm]
    set minus    [tix getimage minus]
    set minusarm [tix getimage minusarm]
 
    case $event {
        <Arm> {
            if {$type == "open"} {
                $data(w:hlist) indicator config $ent -image $plusarm
            } else {
                $data(w:hlist) indicator config $ent -image $minusarm
            }
        }
        <Disarm> {
            if {$type == "open"} {
                $data(w:hlist) indicator config $ent -image $plus
            } else {
                $data(w:hlist) indicator config $ent -image $minus
            }
        }
        <Activate> {
            upvar bind bind
            tixCallMethod $w Activate $ent $type
            set bind(%V) $ent
            tixVTree:BrowseCmdHook $w
        }
    }
}
 
proc tixVTree:GetType {w ent} {
    upvar #0 $w data
 
    uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
    if ![$data(w:hlist) indicator exists $ent] {
        return none
    }
 
    set img [$data(w:hlist) indicator cget $ent -image]
 
    if {$img == [tix getimage plus]} {
        return open
    }
    if {$img == [tix getimage plusarm]} {
        return open
    }
    return close
}
 
proc tixVTree:Activate {w ent type} {
    upvar #0 $w data
 
    uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
 
    set plus     [tix getimage plus]
    set minus    [tix getimage minus]
 
    if {$type == "open"} {
        tixCallMethod $w OpenCmd $ent
        $data(w:hlist) indicator config $ent -image $minus
    } else {
        tixCallMethod $w CloseCmd $ent
        $data(w:hlist) indicator config $ent -image $plus
    }
}
 
proc tixVTree:CommandHook {w args} {
    upvar #0 $w data
    upvar bind bind
 
    tixCallMethod $w Command bind
}
 
proc tixVTree:BrowseCmdHook {w args} {
    upvar #0 $w data
    upvar bind bind
 
    tixCallMethod $w BrowseCmd bind
}
 
proc tixVTree:SetMode {w ent mode} {
    upvar #0 $w data
 
    uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
 
    case $mode {
        open {
            $data(w:hlist) indicator create $ent -itemtype image \
                -image [tix getimage plus]  -style $data(indStyle)
        }
        close {
            $data(w:hlist) indicator create $ent -itemtype image \
                -image [tix getimage minus] -style $data(indStyle)
        }
        none {
            if [$data(w:hlist) indicator exist $ent] {
                $data(w:hlist) indicator delete $ent
            }
        }
    }
}
 
#----------------------------------------------------------------------
#
#                       Virtual Methods
#
#----------------------------------------------------------------------
proc tixVTree:OpenCmd {w ent} {
    upvar #0 $w data
 
    # The default action
    foreach kid [$data(w:hlist) info children $ent] {
        $data(w:hlist) show entry $kid
    }
}
 
proc tixVTree:CloseCmd {w ent} {
    upvar #0 $w data
 
    # The default action
    foreach kid [$data(w:hlist) info children $ent] {
        $data(w:hlist) hide entry $kid
    }
}
 
proc tixVTree:Command {w B} {
    upvar #0 $w data
    upvar $B bind
 
    if {$data(-ignoreinvoke)} {
        return
    }
    set ent [tixEvent flag V]
    if [$data(w:hlist) indicator exist $ent] {
        tixVTree:Activate $w $ent [tixVTree:GetType $w $ent]
    }
}
 
proc tixVTree:BrowseCmd {w B} {
}
#----------------------------------------------------------------------
#
#                       Widget commands
#
#----------------------------------------------------------------------

Line No.	Rev	Author	Line
1	578	markom	`# VTree.tcl --`
2			`#`
3			`# Virtual base class for Tree widgets.`
4			`#`
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			`tixWidgetClass tixVTree {`
13			`-virtual true`
14			`-classname TixVTree`
15			`-superclass tixScrolledHList`
16			`-method {`
17			`}`
18			`-flag {`
19			`-ignoreinvoke`
20			`}`
21			`-configspec {`
22			`{-ignoreinvoke ignoreInvoke IgnoreInvoke false tixVerifyBoolean}`
23			`}`
24			`-default {`
25			`}`
26			`}`
27
28			`proc tixVTree:InitWidgetRec {w} {`
29			`upvar #0 $w data`
30
31			`tixChainMethod $w InitWidgetRec`
32			`}`
33
34			`proc tixVTree:ConstructWidget {w} {`
35			`upvar #0 $w data`
36
37			`tixChainMethod $w ConstructWidget`
38
39			`set data(indStyle) [tixDisplayStyle image -refwindow $data(w:hlist) \`
40			`-padx 0 -pady 0]`
41			`}`
42
43			`proc tixVTree:SetBindings {w} {`
44			`upvar #0 $w data`
45
46			`tixChainMethod $w SetBindings`
47
48			`$data(w:hlist) config \`
49			`-indicatorcmd "tixVTree:IndicatorCmd $w" \`
50			`-browsecmd "tixVTree:BrowseCmdHook $w"\`
51			`-command "tixVTree:CommandHook $w"`
52			`}`
53
54			`proc tixVTree:IndicatorCmd {w args} {`
55			`upvar #0 $w data`
56
57			`uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]`
58			`set event [tixEvent type]`
59			`set ent [tixEvent flag V]`
60
61			`set type [tixVTree:GetType $w $ent]`
62			`set plus [tix getimage plus]`
63			`set plusarm [tix getimage plusarm]`
64			`set minus [tix getimage minus]`
65			`set minusarm [tix getimage minusarm]`
66
67			`case $event {`
68			`<Arm> {`
69			`if {$type == "open"} {`
70			`$data(w:hlist) indicator config $ent -image $plusarm`
71			`} else {`
72			`$data(w:hlist) indicator config $ent -image $minusarm`
73			`}`
74			`}`
75			`<Disarm> {`
76			`if {$type == "open"} {`
77			`$data(w:hlist) indicator config $ent -image $plus`
78			`} else {`
79			`$data(w:hlist) indicator config $ent -image $minus`
80			`}`
81			`}`
82			`<Activate> {`
83			`upvar bind bind`
84			`tixCallMethod $w Activate $ent $type`
85			`set bind(%V) $ent`
86			`tixVTree:BrowseCmdHook $w`
87			`}`
88			`}`
89			`}`
90
91			`proc tixVTree:GetType {w ent} {`
92			`upvar #0 $w data`
93
94			`uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]`
95			`if ![$data(w:hlist) indicator exists $ent] {`
96			`return none`
97			`}`
98
99			`set img [$data(w:hlist) indicator cget $ent -image]`
100
101			`if {$img == [tix getimage plus]} {`
102			`return open`
103			`}`
104			`if {$img == [tix getimage plusarm]} {`
105			`return open`
106			`}`
107			`return close`
108			`}`
109
110			`proc tixVTree:Activate {w ent type} {`
111			`upvar #0 $w data`
112
113			`uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]`
114
115			`set plus [tix getimage plus]`
116			`set minus [tix getimage minus]`
117
118			`if {$type == "open"} {`
119			`tixCallMethod $w OpenCmd $ent`
120			`$data(w:hlist) indicator config $ent -image $minus`
121			`} else {`
122			`tixCallMethod $w CloseCmd $ent`
123			`$data(w:hlist) indicator config $ent -image $plus`
124			`}`
125			`}`
126
127			`proc tixVTree:CommandHook {w args} {`
128			`upvar #0 $w data`
129			`upvar bind bind`
130
131			`tixCallMethod $w Command bind`
132			`}`
133
134			`proc tixVTree:BrowseCmdHook {w args} {`
135			`upvar #0 $w data`
136			`upvar bind bind`
137
138			`tixCallMethod $w BrowseCmd bind`
139			`}`
140
141			`proc tixVTree:SetMode {w ent mode} {`
142			`upvar #0 $w data`
143
144			`uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]`
145
146			`case $mode {`
147			`open {`
148			`$data(w:hlist) indicator create $ent -itemtype image \`
149			`-image [tix getimage plus] -style $data(indStyle)`
150			`}`
151			`close {`
152			`$data(w:hlist) indicator create $ent -itemtype image \`
153			`-image [tix getimage minus] -style $data(indStyle)`
154			`}`
155			`none {`
156			`if [$data(w:hlist) indicator exist $ent] {`
157			`$data(w:hlist) indicator delete $ent`
158			`}`
159			`}`
160			`}`
161			`}`
162
163			`#----------------------------------------------------------------------`
164			`#`
165			`# Virtual Methods`
166			`#`
167			`#----------------------------------------------------------------------`
168			`proc tixVTree:OpenCmd {w ent} {`
169			`upvar #0 $w data`
170
171			`# The default action`
172			`foreach kid [$data(w:hlist) info children $ent] {`
173			`$data(w:hlist) show entry $kid`
174			`}`
175			`}`
176
177			`proc tixVTree:CloseCmd {w ent} {`
178			`upvar #0 $w data`
179
180			`# The default action`
181			`foreach kid [$data(w:hlist) info children $ent] {`
182			`$data(w:hlist) hide entry $kid`
183			`}`
184			`}`
185
186			`proc tixVTree:Command {w B} {`
187			`upvar #0 $w data`
188			`upvar $B bind`
189
190			`if {$data(-ignoreinvoke)} {`
191			`return`
192			`}`
193			`set ent [tixEvent flag V]`
194			`if [$data(w:hlist) indicator exist $ent] {`
195			`tixVTree:Activate $w $ent [tixVTree:GetType $w $ent]`
196			`}`
197			`}`
198
199			`proc tixVTree:BrowseCmd {w B} {`
200			`}`
201			`#----------------------------------------------------------------------`
202			`#`
203			`# Widget commands`
204			`#`
205			`#----------------------------------------------------------------------`

Browse

Tools

Subversion Repositories or1k

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