blob: 809b267088b3c1624e0424b1b53c6b4edd184699 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
package require treectrl
package require tkdnd
namespace eval ::ix {
variable _
proc tree {t target title auto echo path delim} {
variable _
puts "$t $target $title $echo $path $delim"
if {[$t element names] != "el1"} {
$t column create -text $title
$t element create el1 text -fill [list green {selected focus}]
$t style create s1
$t style elements s1 el1
}
bind $t <Button1-Leave> {dnd drag %W}
bind $t <ButtonPress-1> {
set id [lindex [%W identify %x %y] 1]
if {$id ne "" && $id ne "tail"} {
%W activate $id
::ix::tree_click %W [winfo name %W]
}
}
dnd bindsource $t text/plain "return \[::ix::tree_get $t $target -1 -1\]"
bind $t <Tab> "::ix::tree_out $t $target -1"
bind $t <KeyPress-Right> "::ix::tree_out $t $target -1"
bind $t <Double-1> "::ix::tree_out $t $target -1"
bind $t <ButtonPress-3> {}
bind $t <ButtonPress-3> {
variable _
focus %W
set target [winfo name %W]
set id [lindex [%W identify %x %y] 1]
if {$id ne ""} {
%W activate $id
%W selection clear all
%W selection add $id
set path [::ix::tree_get %W $target 1 -1]
if {[winfo exists %W.rc] != 1} {
set m [menu %W.rc -tearoff no]
$m add command -label "path [::ix::tree_get %W $target -1 $id]" -state disabled
$m add command -label delete -command {
::ix::tree_msg $target "delete [pdtk_enquote $path]"
set p [%W item parent $id]
%W item delete $id
if {[%W item numchildren $p] < 1} {
%W item configure $p -button no
}
}
$m add command -label new -command {
::ix::tree_nameitem %W $target $path $id
}
$m add command -label copy -command {::ix::tree_msg $target "copy [pdtk_enquote $path]"}
$m add command -label cut -command {::ix::tree_msg $target "cut [pdtk_enquote $path]"}
$m add command -label paste -command {::ix::tree_msg $target "paste [pdtk_enquote $path]"}
} else {
%W.rc entryconfigure 0 -label "path [::ix::tree_get %W $target -1 $id]"
}
tk_popup %W.rc %X %Y
} else {
if {[winfo exists %W.rroot] != 1} {
set m [menu %W.rroot -tearoff no]
$m add command -label "new root" -command {
::ix::tree_nameitem %W $target "" 0
}
}
tk_popup %W.rroot %X %Y
}
}
set _($target:parentList) [list root {} {} {} {} {} {}]
set _($target:auto) $auto
set _($target:echo) $echo
set _($target:path) $path
set _($target:delim) $delim
}
proc tree_nameitem {t target path id} {
set path "$path/"
destroy .$path
toplevel .$path
entry .$path.entry -textvariable send_textvariable
.$path.entry delete 0 end
.$path.entry insert 0 [::ix::random_txt 6]
.$path.entry select from 0
.$path.entry select adjust end
# if {$path == "/"} {set pathname ""} else {set pathname path}
set submit "::ix::tree_msg $target \"new \[pdtk_enquote \"$path\$send_textvariable\"\]\";::ix::tree_item $t $id \$send_textvariable;destroy .$path"
bind .$path.entry <KeyPress-Return> $submit
button .$path.ok -text "OK" -command $submit
button .$path.cancel -text cancel -command "destroy .$path"
pdtk_standardkeybindings .$path.entry
grid .$path.entry -sticky news -columnspan 2
grid .$path.ok .$path.cancel -sticky news
grid columnconfigure .$path 1 -weight 1
focus .$path.entry
}
proc random_txt {n} {
set i 0
set text ""
while {$i < $n} {
set int [expr "int(floor(rand()*62))"]
if {$int < 10} {incr int 48} elseif {$int < 36} {incr int 55} else {incr int 61}
set text "$text[format %c $int]"
incr i
}
return $text
}
proc tree_item {t p text} {
set ti [$t item create]
$t item style set $ti 0 s1
$t item text $ti 0 $text
$t item lastchild $p $ti
$t item configure $p -button yes
return $ti
}
proc tree_add {t target args} {
variable _
set depth [lindex $args 0]
set text [lrange $args 1 end]
set p [lindex $_($target:parentList) $depth]
set ti [tree_item $t $p $text]
incr depth
set _($target:parentList) [lreplace $_($target:parentList) $depth $depth $ti]
# if {$_($target:auto) == 1} {
# tree_msg $target "new [tree_get $t $target -1 $ti]"
# }
}
proc tree_click {t target} {
variable _
if {$_($target:auto) == 1} {tree_out $t $target -1}
}
proc tree_cmd {t target args} {
variable _
puts "$t $args"
set r [eval "$t $args"]
if {$_($target:echo) == 1} {pd "$target.rp _cb $r;"}
}
proc tree_out {t target rec} {
tree_msg $target [tree_get $t $target $rec -1]
}
proc tree_msg {target msg} {
pd "$target.rp _cb $msg;"
}
proc tree_get {t target rec it} {
variable _
if {$it < 0} {set it [$t index active]}
if {$rec < 0} {set rec $_($target:path)}
if {$rec > 0} {return [tree_getrec $t $target $it ""]} else {
set item [$t item text $it 0]
return $item
}
}
proc tree_getrec {t target tr dl} {
variable _
if {$tr > 0} {
lappend dl $tr
tree_getrec $t $target [$t item parent $tr] $dl
} else {
set tr ""
for {set i [expr [llength $dl] - 1]} {0 <= $i} {incr i -1} {
set tr "$tr$_($target:delim)[$t item text [lindex $dl $i] 0]"
}
return $tr
}
}
proc tree_cfg {target item arg} {
variable _
set _($target:$item) $arg
}
}
#> tree treectrl
#. -height 400 -width 200
#. #title 1 #auto 1 #echo 0 #path 1 #delim "/"
#. -font {tahoma 8} -showroot yes -showrootbutton no -selectmode single
#. @list ::ix::tree_list .- .| .#args
#. @clear .- item delete all
#. @add ::ix::tree_add .- .| .#args
#. @cmd ::ix::tree_cmd .- .| .#args
#. @auto ::ix::tree_cfg .| auto .#1
#. @echo ::ix::tree_cfg .| echo .#1
#. @path ::ix::tree_cfg .| path .#1
#. @delim ::ix::tree_cfg .| delim .#1
::ix::tree .- .| .#title .#auto .#echo .#path .#delim
|
