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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [HListDD.tcl] - Blame information for rev 1767

Go to most recent revision | Details | Compare with Previous | View Log


# HListDD.tcl --
#
#       !!! PRE-ALPHA CODE, NOT USED, DON'T USE !!!
#
#       This file implements drag+drop for HList.
#
# 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.
#
 
#
# events
#
#
 
proc tixHListSingle:DragTimer {w ent} {
    case [tixHListSingle:GetState $w] {
        {1} {
            # fire up
        }
    }
}
 
 
 
 
 
#----------------------------------------------------------------------
#
#                   Drag + Drop Bindings
#
#----------------------------------------------------------------------
 
             #----------------------------------------#
             #            Sending Actions             #
             #----------------------------------------#
 
#----------------------------------------------------------------------
#  tixHListSingle:Send:WaitDrag --
#
#       Sender wait for dragging action
#----------------------------------------------------------------------
proc tixHListSingle:Send:WaitDrag {w x y} {
    global tixPriv
 
    set ent [tixHListSingle:GetNearest $w $y]
    if {$ent != ""} {
        $w anchor set $ent
        $w select clear
        $w select set $ent
 
        set tixPriv(dd,$w:moved) 0
        set tixPriv(dd,$w:entry) $ent
 
#       set browsecmd [$w cget -browsecmd]
#       if {$browsecmd != "" && $ent != ""} {
#           eval $browsecmd $ent
#       }
    }
}
 
proc tixHListSingle:Send:StartDrag {w x y} {
    global tixPriv
    set dd [tixGetDragDropContext $w]
 
    if {![info exists tixPriv(dd,$w:entry)]} {
        return
    }
    if {$tixPriv(dd,$w:entry) == ""} {
        return
    }
 
    if {$tixPriv(dd,$w:moved) == 0} {
        $w dragsite set $tixPriv(dd,$w:entry)
        set tixPriv(dd,$w:moved) 1
        $dd config -source $w -command "tixHListSingle:Send:Cmd $w"
        $dd startdrag $X $Y
    } else {
        $dd drag $X $Y
    }
}
 
proc tixHListSingle:Send:DoneDrag {w x y} {
    global tixPriv
    global moved
 
    if {![info exists tixPriv(dd,$w:entry)]} {
        return
    }
    if {$tixPriv(dd,$w:entry) == ""} {
        return
    }
 
    if {$tixPriv(dd,$w:moved) == 1} {
        set dd [tixGetDragDropContext $w]
        $dd drop $X $Y
    }
    $w dragsite clear
    catch {unset tixPriv(dd,$w:moved)}
    catch {unset tixPriv(dd,$w:entry)}
}
 
proc tixHListSingle:Send:Cmd {w option args} {
    set dragCmd [$w cget -dragcmd]
    if {$dragCmd != ""} {
        return [eval $dragCmd $option $args]
    }
 
    # Perform the default action
    #
    case "$option" {
        who {
            return $w
        }
        types {
            return {data text}
        }
        get {
            global tixPriv
            if {[lindex $args 0] == "text"} {
                if {$tixPriv(dd,$w:entry) != ""} {
                    return [$w entrycget $tixPriv(dd,$w:entry) -text]
                }
            }
            if {[lindex $args 0] == "data"} {
                if {$tixPriv(dd,$w:entry) != ""} {
                    return [$w entrycget $tixPriv(dd,$w:entry) -data]
                }
            }
        }
    }
}
 
             #----------------------------------------#
             #            Receiving Actions           #
             #----------------------------------------#
proc tixHListSingle:Rec:DragOver {w sender x y} {
    if {[$w cget -selectmode] != "dragdrop"} {
        return
    }
 
    set ent [tixHListSingle:GetNearest $w $y]
    if {$ent != ""} {
        $w dropsite set $ent
    } else {
        $w dropsite clear
    }
}
 
proc tixHListSingle:Rec:DragIn {w sender x y} {
    if {[$w cget -selectmode] != "dragdrop"} {
        return
    }
    set ent [tixHListSingle:GetNearest $w $y]
    if {$ent != ""} {
        $w dropsite set $ent
    } else {
        $w dropsite clear
    }
}
 
proc tixHListSingle:Rec:DragOut {w sender x y} {
    if {[$w cget -selectmode] != "dragdrop"} {
        return
    }
    $w dropsite clear
}
 
proc tixHListSingle:Rec:Drop {w sender x y} {
    if {[$w cget -selectmode] != "dragdrop"} {
        return
    }
    $w dropsite clear
 
    set ent [tixHListSingle:GetNearest $w $y]
    if {$ent != ""} {
        $w anchor set $ent
        $w select clear
        $w select set $ent
    }
 
    set dropCmd [$w cget -dropcmd]
    if {$dropCmd != ""} {
        eval $dropCmd $sender $x $y
        return
    }
 
#    set browsecmd [$w cget -browsecmd]
#    if {$browsecmd != "" && $ent != ""} {
#       eval $browsecmd [list $ent]
#    }
}
 
tixDropBind TixHListSingle <In>   "tixHListSingle:Rec:DragIn %W %S %x %y"
tixDropBind TixHListSingle <Over> "tixHListSingle:Rec:DragOver %W %S %x %y"
tixDropBind TixHListSingle <Out>  "tixHListSingle:Rec:DragOut %W %S %x %y"
tixDropBind TixHListSingle <Drop> "tixHListSingle:Rec:Drop %W %S %x %y"

Line No.	Rev	Author	Line
1	578	markom	`# HListDD.tcl --`
2			`#`
3			`# !!! PRE-ALPHA CODE, NOT USED, DON'T USE !!!`
4			`#`
5			`# This file implements drag+drop for HList.`
6			`#`
7			`# Copyright (c) 1996, Expert Interface Technologies`
8			`#`
9			`# See the file "license.terms" for information on usage and redistribution`
10			`# of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
11			`#`
12
13			`#`
14			`# events`
15			`#`
16			`#`
17
18			`proc tixHListSingle:DragTimer {w ent} {`
19			`case [tixHListSingle:GetState $w] {`
20			`{1} {`
21			`# fire up`
22			`}`
23			`}`
24			`}`
25
26
27
28
29
30			`#----------------------------------------------------------------------`
31			`#`
32			`# Drag + Drop Bindings`
33			`#`
34			`#----------------------------------------------------------------------`
35
36			`#----------------------------------------#`
37			`# Sending Actions #`
38			`#----------------------------------------#`
39
40			`#----------------------------------------------------------------------`
41			`# tixHListSingle:Send:WaitDrag --`
42			`#`
43			`# Sender wait for dragging action`
44			`#----------------------------------------------------------------------`
45			`proc tixHListSingle:Send:WaitDrag {w x y} {`
46			`global tixPriv`
47
48			`set ent [tixHListSingle:GetNearest $w $y]`
49			`if {$ent != ""} {`
50			`$w anchor set $ent`
51			`$w select clear`
52			`$w select set $ent`
53
54			`set tixPriv(dd,$w:moved) 0`
55			`set tixPriv(dd,$w:entry) $ent`
56
57			`# set browsecmd [$w cget -browsecmd]`
58			`# if {$browsecmd != "" && $ent != ""} {`
59			`# eval $browsecmd $ent`
60			`# }`
61			`}`
62			`}`
63
64			`proc tixHListSingle:Send:StartDrag {w x y} {`
65			`global tixPriv`
66			`set dd [tixGetDragDropContext $w]`
67
68			`if {![info exists tixPriv(dd,$w:entry)]} {`
69			`return`
70			`}`
71			`if {$tixPriv(dd,$w:entry) == ""} {`
72			`return`
73			`}`
74
75			`if {$tixPriv(dd,$w:moved) == 0} {`
76			`$w dragsite set $tixPriv(dd,$w:entry)`
77			`set tixPriv(dd,$w:moved) 1`
78			`$dd config -source $w -command "tixHListSingle:Send:Cmd $w"`
79			`$dd startdrag $X $Y`
80			`} else {`
81			`$dd drag $X $Y`
82			`}`
83			`}`
84
85			`proc tixHListSingle:Send:DoneDrag {w x y} {`
86			`global tixPriv`
87			`global moved`
88
89			`if {![info exists tixPriv(dd,$w:entry)]} {`
90			`return`
91			`}`
92			`if {$tixPriv(dd,$w:entry) == ""} {`
93			`return`
94			`}`
95
96			`if {$tixPriv(dd,$w:moved) == 1} {`
97			`set dd [tixGetDragDropContext $w]`
98			`$dd drop $X $Y`
99			`}`
100			`$w dragsite clear`
101			`catch {unset tixPriv(dd,$w:moved)}`
102			`catch {unset tixPriv(dd,$w:entry)}`
103			`}`
104
105			`proc tixHListSingle:Send:Cmd {w option args} {`
106			`set dragCmd [$w cget -dragcmd]`
107			`if {$dragCmd != ""} {`
108			`return [eval $dragCmd $option $args]`
109			`}`
110
111			`# Perform the default action`
112			`#`
113			`case "$option" {`
114			`who {`
115			`return $w`
116			`}`
117			`types {`
118			`return {data text}`
119			`}`
120			`get {`
121			`global tixPriv`
122			`if {[lindex $args 0] == "text"} {`
123			`if {$tixPriv(dd,$w:entry) != ""} {`
124			`return [$w entrycget $tixPriv(dd,$w:entry) -text]`
125			`}`
126			`}`
127			`if {[lindex $args 0] == "data"} {`
128			`if {$tixPriv(dd,$w:entry) != ""} {`
129			`return [$w entrycget $tixPriv(dd,$w:entry) -data]`
130			`}`
131			`}`
132			`}`
133			`}`
134			`}`
135
136			`#----------------------------------------#`
137			`# Receiving Actions #`
138			`#----------------------------------------#`
139			`proc tixHListSingle:Rec:DragOver {w sender x y} {`
140			`if {[$w cget -selectmode] != "dragdrop"} {`
141			`return`
142			`}`
143
144			`set ent [tixHListSingle:GetNearest $w $y]`
145			`if {$ent != ""} {`
146			`$w dropsite set $ent`
147			`} else {`
148			`$w dropsite clear`
149			`}`
150			`}`
151
152			`proc tixHListSingle:Rec:DragIn {w sender x y} {`
153			`if {[$w cget -selectmode] != "dragdrop"} {`
154			`return`
155			`}`
156			`set ent [tixHListSingle:GetNearest $w $y]`
157			`if {$ent != ""} {`
158			`$w dropsite set $ent`
159			`} else {`
160			`$w dropsite clear`
161			`}`
162			`}`
163
164			`proc tixHListSingle:Rec:DragOut {w sender x y} {`
165			`if {[$w cget -selectmode] != "dragdrop"} {`
166			`return`
167			`}`
168			`$w dropsite clear`
169			`}`
170
171			`proc tixHListSingle:Rec:Drop {w sender x y} {`
172			`if {[$w cget -selectmode] != "dragdrop"} {`
173			`return`
174			`}`
175			`$w dropsite clear`
176
177			`set ent [tixHListSingle:GetNearest $w $y]`
178			`if {$ent != ""} {`
179			`$w anchor set $ent`
180			`$w select clear`
181			`$w select set $ent`
182			`}`
183
184			`set dropCmd [$w cget -dropcmd]`
185			`if {$dropCmd != ""} {`
186			`eval $dropCmd $sender $x $y`
187			`return`
188			`}`
189
190			`# set browsecmd [$w cget -browsecmd]`
191			`# if {$browsecmd != "" && $ent != ""} {`
192			`# eval $browsecmd [list $ent]`
193			`# }`
194			`}`
195
196			`tixDropBind TixHListSingle <In> "tixHListSingle:Rec:DragIn %W %S %x %y"`
197			`tixDropBind TixHListSingle <Over> "tixHListSingle:Rec:DragOver %W %S %x %y"`
198			`tixDropBind TixHListSingle <Out> "tixHListSingle:Rec:DragOut %W %S %x %y"`
199			`tixDropBind TixHListSingle <Drop> "tixHListSingle:Rec:Drop %W %S %x %y"`

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [HListDD.tcl] - Blame information for rev 1767