1 |
578 |
markom |
# Hierarchy
|
2 |
|
|
# ----------------------------------------------------------------------
|
3 |
|
|
# Hierarchical data viewer. Manages a list of nodes that can be
|
4 |
|
|
# expanded or collapsed. Individual nodes can be highlighted.
|
5 |
|
|
# Clicking with the right mouse button on any item brings up a
|
6 |
|
|
# special item menu. Clicking on the background area brings up
|
7 |
|
|
# a different popup menu.
|
8 |
|
|
# ----------------------------------------------------------------------
|
9 |
|
|
# AUTHOR: Michael J. McLennan
|
10 |
|
|
# Bell Labs Innovations for Lucent Technologies
|
11 |
|
|
# mmclennan@lucent.com
|
12 |
|
|
#
|
13 |
|
|
# Mark L. Ulferts
|
14 |
|
|
# DSC Communications
|
15 |
|
|
# mulferts@austin.dsccc.com
|
16 |
|
|
#
|
17 |
|
|
# RCS: $Id: hierarchy.itk,v 1.1.1.1 2002-01-16 10:24:50 markom Exp $
|
18 |
|
|
# ----------------------------------------------------------------------
|
19 |
|
|
# Copyright (c) 1996 Lucent Technologies
|
20 |
|
|
# ======================================================================
|
21 |
|
|
# Permission to use, copy, modify, and distribute this software and its
|
22 |
|
|
# documentation for any purpose and without fee is hereby granted,
|
23 |
|
|
# provided that the above copyright notice appear in all copies and that
|
24 |
|
|
# both that the copyright notice and warranty disclaimer appear in
|
25 |
|
|
# supporting documentation, and that the names of Lucent Technologies
|
26 |
|
|
# any of their entities not be used in advertising or publicity
|
27 |
|
|
# pertaining to distribution of the software without specific, written
|
28 |
|
|
# prior permission.
|
29 |
|
|
#
|
30 |
|
|
# Lucent Technologies disclaims all warranties with regard to this
|
31 |
|
|
# software, including all implied warranties of merchantability and
|
32 |
|
|
# fitness. In no event shall Lucent Technologies be liable for any
|
33 |
|
|
# special, indirect or consequential damages or any damages whatsoever
|
34 |
|
|
# resulting from loss of use, data or profits, whether in an action of
|
35 |
|
|
# contract, negligence or other tortuous action, arising out of or in
|
36 |
|
|
# connection with the use or performance of this software.
|
37 |
|
|
#
|
38 |
|
|
# ----------------------------------------------------------------------
|
39 |
|
|
# Copyright (c) 1996 DSC Technologies Corporation
|
40 |
|
|
# ======================================================================
|
41 |
|
|
# Permission to use, copy, modify, distribute and license this software
|
42 |
|
|
# and its documentation for any purpose, and without fee or written
|
43 |
|
|
# agreement with DSC, is hereby granted, provided that the above copyright
|
44 |
|
|
# notice appears in all copies and that both the copyright notice and
|
45 |
|
|
# warranty disclaimer below appear in supporting documentation, and that
|
46 |
|
|
# the names of DSC Technologies Corporation or DSC Communications
|
47 |
|
|
# Corporation not be used in advertising or publicity pertaining to the
|
48 |
|
|
# software without specific, written prior permission.
|
49 |
|
|
#
|
50 |
|
|
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
|
51 |
|
|
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
|
52 |
|
|
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
|
53 |
|
|
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
|
54 |
|
|
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
|
55 |
|
|
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
|
56 |
|
|
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
|
57 |
|
|
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
|
58 |
|
|
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
|
59 |
|
|
# SOFTWARE.
|
60 |
|
|
# ======================================================================
|
61 |
|
|
|
62 |
|
|
#
|
63 |
|
|
# Usual options.
|
64 |
|
|
#
|
65 |
|
|
itk::usual Hierarchy {
|
66 |
|
|
keep -cursor -textfont -font
|
67 |
|
|
keep -background -foreground -textbackground
|
68 |
|
|
keep -selectbackground -selectforeground
|
69 |
|
|
}
|
70 |
|
|
|
71 |
|
|
# ------------------------------------------------------------------
|
72 |
|
|
# HIERARCHY
|
73 |
|
|
# ------------------------------------------------------------------
|
74 |
|
|
class iwidgets::Hierarchy {
|
75 |
|
|
inherit iwidgets::Scrolledwidget
|
76 |
|
|
|
77 |
|
|
constructor {args} {}
|
78 |
|
|
|
79 |
|
|
destructor {}
|
80 |
|
|
|
81 |
|
|
itk_option define -alwaysquery alwaysQuery AlwaysQuery 0
|
82 |
|
|
itk_option define -closedicon closedIcon Icon {}
|
83 |
|
|
itk_option define -expanded expanded Expanded 0
|
84 |
|
|
itk_option define -filter filter Filter 0
|
85 |
|
|
itk_option define -font font Font \
|
86 |
|
|
-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
|
87 |
|
|
itk_option define -height height Height 0
|
88 |
|
|
itk_option define -iconcommand iconCommand Command {}
|
89 |
|
|
itk_option define -markbackground markBackground Foreground #a0a0a0
|
90 |
|
|
itk_option define -markforeground markForeground Background Black
|
91 |
|
|
itk_option define -nodeicon nodeIcon Icon {}
|
92 |
|
|
itk_option define -openicon openIcon Icon {}
|
93 |
|
|
itk_option define -querycommand queryCommand Command {}
|
94 |
|
|
itk_option define -selectcommand selectCommand Command {}
|
95 |
|
|
itk_option define -selectbackground selectBackground Foreground #c3c3c3
|
96 |
|
|
itk_option define -selectforeground selectForeground Background Black
|
97 |
|
|
itk_option define -visibleitems visibleItems VisibleItems 80x24
|
98 |
|
|
itk_option define -width width Width 0
|
99 |
|
|
|
100 |
|
|
public method clear {}
|
101 |
|
|
public method collapse {node}
|
102 |
|
|
public method current {}
|
103 |
|
|
public method draw {{when -now}}
|
104 |
|
|
public method expand {node}
|
105 |
|
|
public method mark {op args}
|
106 |
|
|
public method prune {node}
|
107 |
|
|
public method refresh {node}
|
108 |
|
|
public method selection {op args}
|
109 |
|
|
public method toggle {node}
|
110 |
|
|
|
111 |
|
|
public method bbox {index}
|
112 |
|
|
public method compare {index1 op index2}
|
113 |
|
|
public method debug {args} {eval $args}
|
114 |
|
|
public method delete {first {last {}}}
|
115 |
|
|
public method dlineinfo {index}
|
116 |
|
|
public method dump {args}
|
117 |
|
|
public method get {index1 {index2 {}}}
|
118 |
|
|
public method index {index}
|
119 |
|
|
public method insert {args}
|
120 |
|
|
public method scan {option args}
|
121 |
|
|
public method search {args}
|
122 |
|
|
public method see {index}
|
123 |
|
|
public method tag {op args}
|
124 |
|
|
public method window {option args}
|
125 |
|
|
public method xview {args}
|
126 |
|
|
public method yview {args}
|
127 |
|
|
|
128 |
|
|
protected method _contents {uid}
|
129 |
|
|
protected method _iconSelect {node icon}
|
130 |
|
|
protected method _post {x y}
|
131 |
|
|
protected method _drawLevel {node indent}
|
132 |
|
|
protected method _select {x y}
|
133 |
|
|
protected method _deselectSubNodes {uid}
|
134 |
|
|
protected method _deleteNodeInfo {uid}
|
135 |
|
|
protected method _getParent {uid}
|
136 |
|
|
protected method _getHeritage {uid}
|
137 |
|
|
protected method _isInternalTag {tag}
|
138 |
|
|
|
139 |
|
|
private variable _filterCode "" ;# Compact view flag.
|
140 |
|
|
private variable _hcounter 0 ;# Counter for hierarchy icons
|
141 |
|
|
private variable _icons ;# Array of user icons by uid
|
142 |
|
|
private variable _images ;# Array of our icons by uid
|
143 |
|
|
private variable _indents ;# Array of indentation by uid
|
144 |
|
|
private variable _marked ;# Array of marked nodes by uid
|
145 |
|
|
private variable _markers "" ;# List of markers for level being drawn
|
146 |
|
|
private variable _nodes ;# List of subnodes by uid
|
147 |
|
|
private variable _pending "" ;# Pending draw flag
|
148 |
|
|
private variable _posted "" ;# List of tags at posted menu position
|
149 |
|
|
private variable _selected ;# Array of selected nodes by uid
|
150 |
|
|
private variable _tags ;# Array of user tags by uid
|
151 |
|
|
private variable _text ;# Array of displayed text by uid
|
152 |
|
|
private variable _states ;# Array of selection state by uid
|
153 |
|
|
private variable _ucounter 0 ;# Counter for user icons
|
154 |
|
|
}
|
155 |
|
|
|
156 |
|
|
#
|
157 |
|
|
# Provide a lowercased access method for the Hierarchy class.
|
158 |
|
|
#
|
159 |
|
|
proc ::iwidgets::hierarchy {pathName args} {
|
160 |
|
|
uplevel ::iwidgets::Hierarchy $pathName $args
|
161 |
|
|
}
|
162 |
|
|
|
163 |
|
|
#
|
164 |
|
|
# Use option database to override default resources of base classes.
|
165 |
|
|
#
|
166 |
|
|
option add *Hierarchy.menuCursor arrow widgetDefault
|
167 |
|
|
option add *Hierarchy.labelPos n widgetDefault
|
168 |
|
|
option add *Hierarchy.tabs 30 widgetDefault
|
169 |
|
|
|
170 |
|
|
# ------------------------------------------------------------------
|
171 |
|
|
# CONSTRUCTOR
|
172 |
|
|
# ------------------------------------------------------------------
|
173 |
|
|
body iwidgets::Hierarchy::constructor {args} {
|
174 |
|
|
itk_option remove iwidgets::Labeledwidget::state
|
175 |
|
|
|
176 |
|
|
#
|
177 |
|
|
# Our -width and -height options are slightly different than
|
178 |
|
|
# those implemented by our base class, so we're going to
|
179 |
|
|
# remove them and redefine our own.
|
180 |
|
|
#
|
181 |
|
|
itk_option remove iwidgets::Scrolledwidget::width
|
182 |
|
|
itk_option remove iwidgets::Scrolledwidget::height
|
183 |
|
|
|
184 |
|
|
#
|
185 |
|
|
# Create a clipping frame which will provide the border for
|
186 |
|
|
# relief display.
|
187 |
|
|
#
|
188 |
|
|
itk_component add clipper {
|
189 |
|
|
frame $itk_interior.clipper
|
190 |
|
|
} {
|
191 |
|
|
usual
|
192 |
|
|
|
193 |
|
|
keep -borderwidth -relief -highlightthickness -highlightcolor
|
194 |
|
|
rename -highlightbackground -background background Background
|
195 |
|
|
}
|
196 |
|
|
grid $itk_component(clipper) -row 0 -column 0 -sticky nsew
|
197 |
|
|
grid rowconfigure $_interior 0 -weight 1
|
198 |
|
|
grid columnconfigure $_interior 0 -weight 1
|
199 |
|
|
|
200 |
|
|
#
|
201 |
|
|
# Create a text widget for displaying our hierarchy.
|
202 |
|
|
#
|
203 |
|
|
itk_component add list {
|
204 |
|
|
text $itk_component(clipper).list -wrap none -cursor center_ptr \
|
205 |
|
|
-state disabled -width 1 -height 1 \
|
206 |
|
|
-xscrollcommand \
|
207 |
|
|
[code $this _scrollWidget $itk_interior.horizsb] \
|
208 |
|
|
-yscrollcommand \
|
209 |
|
|
[code $this _scrollWidget $itk_interior.vertsb] \
|
210 |
|
|
-borderwidth 0 -highlightthickness 0
|
211 |
|
|
} {
|
212 |
|
|
usual
|
213 |
|
|
|
214 |
|
|
keep -spacing1 -spacing2 -spacing3 -tabs
|
215 |
|
|
rename -font -textfont textFont Font
|
216 |
|
|
rename -background -textbackground textBackground Background
|
217 |
|
|
ignore -highlightthickness -highlightcolor
|
218 |
|
|
ignore -insertbackground -insertborderwidth
|
219 |
|
|
ignore -insertontime -insertofftime -insertwidth
|
220 |
|
|
ignore -selectborderwidth
|
221 |
|
|
ignore -borderwidth
|
222 |
|
|
}
|
223 |
|
|
grid $itk_component(list) -row 0 -column 0 -sticky nsew
|
224 |
|
|
grid rowconfigure $itk_component(clipper) 0 -weight 1
|
225 |
|
|
grid columnconfigure $itk_component(clipper) 0 -weight 1
|
226 |
|
|
|
227 |
|
|
#
|
228 |
|
|
# Configure the command on the vertical scroll bar in the base class.
|
229 |
|
|
#
|
230 |
|
|
$itk_component(vertsb) configure \
|
231 |
|
|
-command [code $itk_component(list) yview]
|
232 |
|
|
|
233 |
|
|
#
|
234 |
|
|
# Configure the command on the horizontal scroll bar in the base class.
|
235 |
|
|
#
|
236 |
|
|
$itk_component(horizsb) configure \
|
237 |
|
|
-command [code $itk_component(list) xview]
|
238 |
|
|
|
239 |
|
|
#
|
240 |
|
|
# Configure our text component's tab settings for twenty levels.
|
241 |
|
|
#
|
242 |
|
|
set tabs ""
|
243 |
|
|
for {set i 1} {$i < 20} {incr i} {
|
244 |
|
|
lappend tabs [expr $i*12+4]
|
245 |
|
|
}
|
246 |
|
|
$itk_component(list) configure -tabs $tabs
|
247 |
|
|
|
248 |
|
|
#
|
249 |
|
|
# Add popup menus that can be configured by the user to add
|
250 |
|
|
# new functionality.
|
251 |
|
|
#
|
252 |
|
|
itk_component add itemMenu {
|
253 |
|
|
menu $itk_component(list).itemmenu -tearoff 0
|
254 |
|
|
} {
|
255 |
|
|
usual
|
256 |
|
|
ignore -tearoff
|
257 |
|
|
rename -cursor -menucursor menuCursor Cursor
|
258 |
|
|
}
|
259 |
|
|
|
260 |
|
|
itk_component add bgMenu {
|
261 |
|
|
menu $itk_component(list).bgmenu -tearoff 0
|
262 |
|
|
} {
|
263 |
|
|
usual
|
264 |
|
|
ignore -tearoff
|
265 |
|
|
rename -cursor -menucursor menuCursor Cursor
|
266 |
|
|
}
|
267 |
|
|
|
268 |
|
|
#
|
269 |
|
|
# Adjust the bind tags to remove the class bindings. Also, add
|
270 |
|
|
# bindings for mouse button 1 to do selection and button 3 to
|
271 |
|
|
# display a popup.
|
272 |
|
|
#
|
273 |
|
|
bindtags $itk_component(list) [list $itk_component(list) . all]
|
274 |
|
|
|
275 |
|
|
bind $itk_component(list) \
|
276 |
|
|
[code $this _select %x %y]
|
277 |
|
|
|
278 |
|
|
bind $itk_component(list) \
|
279 |
|
|
[code $this _post %x %y]
|
280 |
|
|
|
281 |
|
|
#
|
282 |
|
|
# Initialize the widget based on the command line options.
|
283 |
|
|
#
|
284 |
|
|
eval itk_initialize $args
|
285 |
|
|
}
|
286 |
|
|
|
287 |
|
|
# ------------------------------------------------------------------
|
288 |
|
|
# DESTRUCTOR
|
289 |
|
|
# ------------------------------------------------------------------
|
290 |
|
|
body iwidgets::Hierarchy::destructor {} {
|
291 |
|
|
if {$_pending != ""} {
|
292 |
|
|
after cancel $_pending
|
293 |
|
|
}
|
294 |
|
|
}
|
295 |
|
|
|
296 |
|
|
# ------------------------------------------------------------------
|
297 |
|
|
# OPTIONS
|
298 |
|
|
# ------------------------------------------------------------------
|
299 |
|
|
|
300 |
|
|
# ------------------------------------------------------------------
|
301 |
|
|
# OPTION: -font
|
302 |
|
|
#
|
303 |
|
|
# Font used for text in the list.
|
304 |
|
|
# ------------------------------------------------------------------
|
305 |
|
|
configbody iwidgets::Hierarchy::font {
|
306 |
|
|
$itk_component(list) tag configure info \
|
307 |
|
|
-font $itk_option(-font) -spacing1 6
|
308 |
|
|
}
|
309 |
|
|
|
310 |
|
|
# ------------------------------------------------------------------
|
311 |
|
|
# OPTION: -selectbackground
|
312 |
|
|
#
|
313 |
|
|
# Background color scheme for selected nodes.
|
314 |
|
|
# ------------------------------------------------------------------
|
315 |
|
|
configbody iwidgets::Hierarchy::selectbackground {
|
316 |
|
|
$itk_component(list) tag configure hilite \
|
317 |
|
|
-background $itk_option(-selectbackground)
|
318 |
|
|
}
|
319 |
|
|
|
320 |
|
|
# ------------------------------------------------------------------
|
321 |
|
|
# OPTION: -selectforeground
|
322 |
|
|
#
|
323 |
|
|
# Foreground color scheme for selected nodes.
|
324 |
|
|
# ------------------------------------------------------------------
|
325 |
|
|
configbody iwidgets::Hierarchy::selectforeground {
|
326 |
|
|
$itk_component(list) tag configure hilite \
|
327 |
|
|
-foreground $itk_option(-selectforeground)
|
328 |
|
|
}
|
329 |
|
|
|
330 |
|
|
# ------------------------------------------------------------------
|
331 |
|
|
# OPTION: -markbackground
|
332 |
|
|
#
|
333 |
|
|
# Background color scheme for marked nodes.
|
334 |
|
|
# ------------------------------------------------------------------
|
335 |
|
|
configbody iwidgets::Hierarchy::markbackground {
|
336 |
|
|
$itk_component(list) tag configure lowlite \
|
337 |
|
|
-background $itk_option(-markbackground)
|
338 |
|
|
}
|
339 |
|
|
|
340 |
|
|
# ------------------------------------------------------------------
|
341 |
|
|
# OPTION: -markforeground
|
342 |
|
|
#
|
343 |
|
|
# Foreground color scheme for marked nodes.
|
344 |
|
|
# ------------------------------------------------------------------
|
345 |
|
|
configbody iwidgets::Hierarchy::markforeground {
|
346 |
|
|
$itk_component(list) tag configure lowlite \
|
347 |
|
|
-foreground $itk_option(-markforeground)
|
348 |
|
|
}
|
349 |
|
|
|
350 |
|
|
# ------------------------------------------------------------------
|
351 |
|
|
# OPTION: -querycommand
|
352 |
|
|
#
|
353 |
|
|
# Command executed to query the contents of each node. If this
|
354 |
|
|
# command contains "%n", it is replaced with the name of the desired
|
355 |
|
|
# node. In its simpilest form it should return the children of the
|
356 |
|
|
# given node as a list which will be depicted in the display.
|
357 |
|
|
#
|
358 |
|
|
# Since the names of the children are used as tags in the underlying
|
359 |
|
|
# text widget, each child must be unique in the hierarchy. Due to
|
360 |
|
|
# the unique requirement, the nodes shall be reffered to as uids
|
361 |
|
|
# or uid in the singular sense.
|
362 |
|
|
#
|
363 |
|
|
# {uid [uid ...]}
|
364 |
|
|
#
|
365 |
|
|
# where uid is a unique id and primary key for the hierarchy entry
|
366 |
|
|
#
|
367 |
|
|
# Should the unique requirement pose a problem, the list returned
|
368 |
|
|
# can take on another more extended form which enables the
|
369 |
|
|
# association of text to be displayed with the uids. The uid must
|
370 |
|
|
# still be unique, but the text does not have to obey the unique
|
371 |
|
|
# rule. In addition, the format also allows the specification of
|
372 |
|
|
# additional tags to be used on the same entry in the hierarchy
|
373 |
|
|
# as the uid and additional icons to be displayed just before
|
374 |
|
|
# the node. The tags and icons are considered to be the property of
|
375 |
|
|
# the user in that the hierarchy widget will not depend on any of
|
376 |
|
|
# their values.
|
377 |
|
|
#
|
378 |
|
|
# {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
|
379 |
|
|
#
|
380 |
|
|
# where uid is a unique id and primary key for the hierarchy entry
|
381 |
|
|
# text is the text to be displayed for this uid
|
382 |
|
|
# tags is a list of user tags to be applied to the entry
|
383 |
|
|
# icons is a list of icons to be displayed in front of the text
|
384 |
|
|
#
|
385 |
|
|
# The hierarchy widget does a look ahead from each node to determine
|
386 |
|
|
# if the node has a children. This can be cost some performace with
|
387 |
|
|
# large hierarchies. User's can avoid this by providing a hint in
|
388 |
|
|
# the user tags. A tag of "leaf" or "branch" tells the hierarchy
|
389 |
|
|
# widget the information it needs to know thereby avoiding the look
|
390 |
|
|
# ahead operation.
|
391 |
|
|
# ------------------------------------------------------------------
|
392 |
|
|
configbody iwidgets::Hierarchy::querycommand {
|
393 |
|
|
clear
|
394 |
|
|
draw -eventually
|
395 |
|
|
}
|
396 |
|
|
|
397 |
|
|
# ------------------------------------------------------------------
|
398 |
|
|
# OPTION: -selectcommand
|
399 |
|
|
#
|
400 |
|
|
# Command executed to select an item in the list. If this command
|
401 |
|
|
# contains "%n", it is replaced with the name of the selected node.
|
402 |
|
|
# If it contains a "%s", it is replaced with a boolean indicator of
|
403 |
|
|
# the node's current selection status, where a value of 1 denotes
|
404 |
|
|
# that the node is currently selected and 0 that it is not.
|
405 |
|
|
# ------------------------------------------------------------------
|
406 |
|
|
configbody iwidgets::Hierarchy::selectcommand {
|
407 |
|
|
}
|
408 |
|
|
|
409 |
|
|
# ------------------------------------------------------------------
|
410 |
|
|
# OPTION: -iconcommand
|
411 |
|
|
#
|
412 |
|
|
# Command executed upon selection of user icons. If this command
|
413 |
|
|
# contains "%n", it is replaced with the name of the node the icon
|
414 |
|
|
# belongs to. Should it contain "%i" then the icon name is
|
415 |
|
|
# substituted.
|
416 |
|
|
# ------------------------------------------------------------------
|
417 |
|
|
configbody iwidgets::Hierarchy::iconcommand {
|
418 |
|
|
}
|
419 |
|
|
|
420 |
|
|
# ------------------------------------------------------------------
|
421 |
|
|
# OPTION: -alwaysquery
|
422 |
|
|
#
|
423 |
|
|
# Boolean flag which tells the hierarchy widget weather or not
|
424 |
|
|
# each refresh of the display should be via a new query using
|
425 |
|
|
# the -querycommand option or use the values previous found the
|
426 |
|
|
# last time the query was made.
|
427 |
|
|
# ------------------------------------------------------------------
|
428 |
|
|
configbody iwidgets::Hierarchy::alwaysquery {
|
429 |
|
|
}
|
430 |
|
|
|
431 |
|
|
# ------------------------------------------------------------------
|
432 |
|
|
# OPTION: -filter
|
433 |
|
|
#
|
434 |
|
|
# When true only the branch nodes and selected items are displayed.
|
435 |
|
|
# This gives a compact view of important items.
|
436 |
|
|
# ------------------------------------------------------------------
|
437 |
|
|
configbody iwidgets::Hierarchy::filter {
|
438 |
|
|
switch -- $itk_option(-filter) {
|
439 |
|
|
1 - true - yes - on {
|
440 |
|
|
set newCode {set display [info exists _selected($child)]}
|
441 |
|
|
}
|
442 |
|
|
|
443 |
|
|
set newCode {set display 1}
|
444 |
|
|
}
|
445 |
|
|
default {
|
446 |
|
|
error "bad filter option \"$itk_option(-filter)\":\
|
447 |
|
|
should be boolean"
|
448 |
|
|
}
|
449 |
|
|
}
|
450 |
|
|
if {$newCode != $_filterCode} {
|
451 |
|
|
set _filterCode $newCode
|
452 |
|
|
draw -eventually
|
453 |
|
|
}
|
454 |
|
|
}
|
455 |
|
|
|
456 |
|
|
# ------------------------------------------------------------------
|
457 |
|
|
# OPTION: -expanded
|
458 |
|
|
#
|
459 |
|
|
# When true, the hierarchy will be completely expanded when it
|
460 |
|
|
# is first displayed. A fresh display can be triggered by
|
461 |
|
|
# resetting the -querycommand option.
|
462 |
|
|
# ------------------------------------------------------------------
|
463 |
|
|
configbody iwidgets::Hierarchy::expanded {
|
464 |
|
|
switch -- $itk_option(-expanded) {
|
465 |
|
|
1 - true - yes - on {
|
466 |
|
|
;# okay
|
467 |
|
|
}
|
468 |
|
|
|
469 |
|
|
;# okay
|
470 |
|
|
}
|
471 |
|
|
default {
|
472 |
|
|
error "bad expanded option \"$itk_option(-expanded)\":\
|
473 |
|
|
should be boolean"
|
474 |
|
|
}
|
475 |
|
|
}
|
476 |
|
|
}
|
477 |
|
|
|
478 |
|
|
# ------------------------------------------------------------------
|
479 |
|
|
# OPTION: -openicon
|
480 |
|
|
#
|
481 |
|
|
# Specifies the open icon image to be used in the hierarchy. Should
|
482 |
|
|
# one not be provided, then one will be generated, pixmap if
|
483 |
|
|
# possible, bitmap otherwise.
|
484 |
|
|
# ------------------------------------------------------------------
|
485 |
|
|
configbody iwidgets::Hierarchy::openicon {
|
486 |
|
|
if {$itk_option(-openicon) == {}} {
|
487 |
|
|
if {[lsearch [image names] openFolder] == -1} {
|
488 |
|
|
if {[lsearch [image types] pixmap] != -1} {
|
489 |
|
|
image create pixmap openFolder -data {
|
490 |
|
|
/* XPM */
|
491 |
|
|
static char * dir_opened [] = {
|
492 |
|
|
"16 16 4 1",
|
493 |
|
|
/* colors */
|
494 |
|
|
". c grey85 m white g4 grey90",
|
495 |
|
|
"b c black m black g4 black",
|
496 |
|
|
"y c yellow m white g4 grey80",
|
497 |
|
|
"g c grey70 m white g4 grey70",
|
498 |
|
|
/* pixels */
|
499 |
|
|
"................",
|
500 |
|
|
"................",
|
501 |
|
|
"................",
|
502 |
|
|
"..bbbb..........",
|
503 |
|
|
".bggggb.........",
|
504 |
|
|
"bggggggbbbbbbb..",
|
505 |
|
|
"bggggggggggggb..",
|
506 |
|
|
"bgbbbbbbbbbbbbbb",
|
507 |
|
|
"bgbyyyyyyyyyyybb",
|
508 |
|
|
"bbyyyyyyyyyyyyb.",
|
509 |
|
|
"bbyyyyyyyyyyybb.",
|
510 |
|
|
"byyyyyyyyyyyyb..",
|
511 |
|
|
"bbbbbbbbbbbbbb..",
|
512 |
|
|
"................",
|
513 |
|
|
"................",
|
514 |
|
|
"................"};
|
515 |
|
|
}
|
516 |
|
|
} else {
|
517 |
|
|
image create bitmap openFolder -data {
|
518 |
|
|
#define open_width 16
|
519 |
|
|
#define open_height 16
|
520 |
|
|
static char open_bits[] = {
|
521 |
|
|
0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, 0x42, 0x00,
|
522 |
|
|
0x81, 0x3f, 0x01, 0x20, 0xf9, 0xff, 0x0d, 0xc0,
|
523 |
|
|
0x07, 0x40, 0x03, 0x60, 0x01, 0x20, 0x01, 0x30,
|
524 |
|
|
0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
|
525 |
|
|
}
|
526 |
|
|
}
|
527 |
|
|
|
528 |
|
|
set itk_option(-openicon) openFolder
|
529 |
|
|
}
|
530 |
|
|
|
531 |
|
|
} else {
|
532 |
|
|
if {[lsearch [image names] $itk_option(-openicon)] == -1} {
|
533 |
|
|
error "bad openicon option \"$itk_option(-openicon)\":\
|
534 |
|
|
should be an existing image"
|
535 |
|
|
}
|
536 |
|
|
}
|
537 |
|
|
}
|
538 |
|
|
|
539 |
|
|
# ------------------------------------------------------------------
|
540 |
|
|
# OPTION: -closedicon
|
541 |
|
|
#
|
542 |
|
|
# Specifies the closed icon image to be used in the hierarchy.
|
543 |
|
|
# Should one not be provided, then one will be generated, pixmap if
|
544 |
|
|
# possible, bitmap otherwise.
|
545 |
|
|
# ------------------------------------------------------------------
|
546 |
|
|
configbody iwidgets::Hierarchy::closedicon {
|
547 |
|
|
if {$itk_option(-closedicon) == {}} {
|
548 |
|
|
if {[lsearch [image names] closedFolder] == -1} {
|
549 |
|
|
if {[lsearch [image types] pixmap] != -1} {
|
550 |
|
|
image create pixmap closedFolder -data {
|
551 |
|
|
/* XPM */
|
552 |
|
|
static char *dir_closed[] = {
|
553 |
|
|
"16 16 3 1",
|
554 |
|
|
". c grey85 m white g4 grey90",
|
555 |
|
|
"b c black m black g4 black",
|
556 |
|
|
"y c yellow m white g4 grey80",
|
557 |
|
|
"................",
|
558 |
|
|
"................",
|
559 |
|
|
"................",
|
560 |
|
|
"..bbbb..........",
|
561 |
|
|
".byyyyb.........",
|
562 |
|
|
"bbbbbbbbbbbbbb..",
|
563 |
|
|
"byyyyyyyyyyyyb..",
|
564 |
|
|
"byyyyyyyyyyyyb..",
|
565 |
|
|
"byyyyyyyyyyyyb..",
|
566 |
|
|
"byyyyyyyyyyyyb..",
|
567 |
|
|
"byyyyyyyyyyyyb..",
|
568 |
|
|
"byyyyyyyyyyyyb..",
|
569 |
|
|
"bbbbbbbbbbbbbb..",
|
570 |
|
|
"................",
|
571 |
|
|
"................",
|
572 |
|
|
"................"};
|
573 |
|
|
}
|
574 |
|
|
} else {
|
575 |
|
|
image create bitmap closedFolder -data {
|
576 |
|
|
#define closed_width 16
|
577 |
|
|
#define closed_height 16
|
578 |
|
|
static char closed_bits[] = {
|
579 |
|
|
0x00, 0x00, 0x00, 0x00, 0x78, 0x00, 0x84, 0x00,
|
580 |
|
|
0xfe, 0x7f, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
|
581 |
|
|
0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
|
582 |
|
|
0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
|
583 |
|
|
}
|
584 |
|
|
}
|
585 |
|
|
|
586 |
|
|
set itk_option(-closedicon) closedFolder
|
587 |
|
|
}
|
588 |
|
|
|
589 |
|
|
} else {
|
590 |
|
|
if {[lsearch [image names] $itk_option(-closedicon)] == -1} {
|
591 |
|
|
error "bad closedicon option \"$itk_option(-closedicon)\":\
|
592 |
|
|
should be an existing image"
|
593 |
|
|
}
|
594 |
|
|
}
|
595 |
|
|
}
|
596 |
|
|
|
597 |
|
|
# ------------------------------------------------------------------
|
598 |
|
|
# OPTION: -nodeicon
|
599 |
|
|
#
|
600 |
|
|
# Specifies the node icon image to be used in the hierarchy. Should
|
601 |
|
|
# one not be provided, then one will be generated, pixmap if
|
602 |
|
|
# possible, bitmap otherwise.
|
603 |
|
|
# ------------------------------------------------------------------
|
604 |
|
|
configbody iwidgets::Hierarchy::nodeicon {
|
605 |
|
|
if {$itk_option(-nodeicon) == {}} {
|
606 |
|
|
if {[lsearch [image names] nodeFolder] == -1} {
|
607 |
|
|
if {[lsearch [image types] pixmap] != -1} {
|
608 |
|
|
image create pixmap nodeFolder -data {
|
609 |
|
|
/* XPM */
|
610 |
|
|
static char *dir_node[] = {
|
611 |
|
|
"16 16 3 1",
|
612 |
|
|
". c grey85 m white g4 grey90",
|
613 |
|
|
"b c black m black g4 black",
|
614 |
|
|
"y c yellow m white g4 grey80",
|
615 |
|
|
"................",
|
616 |
|
|
"................",
|
617 |
|
|
"................",
|
618 |
|
|
"...bbbbbbbbbbb..",
|
619 |
|
|
"..bybyyyyyyyyb..",
|
620 |
|
|
".byybyyyyyyyyb..",
|
621 |
|
|
"byyybyyyyyyyyb..",
|
622 |
|
|
"bbbbbyyyyyyyyb..",
|
623 |
|
|
"byyyyyyyyyyyyb..",
|
624 |
|
|
"byyyyyyyyyyyyb..",
|
625 |
|
|
"byyyyyyyyyyyyb..",
|
626 |
|
|
"byyyyyyyyyyyyb..",
|
627 |
|
|
"bbbbbbbbbbbbbb..",
|
628 |
|
|
"................",
|
629 |
|
|
"................",
|
630 |
|
|
"................"};
|
631 |
|
|
}
|
632 |
|
|
} else {
|
633 |
|
|
image create bitmap nodeFolder -data {
|
634 |
|
|
#define node_width 16
|
635 |
|
|
#define node_height 16
|
636 |
|
|
static char node_bits[] = {
|
637 |
|
|
0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x50, 0x40,
|
638 |
|
|
0x48, 0x40, 0x44, 0x40, 0x42, 0x40, 0x7e, 0x40,
|
639 |
|
|
0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
|
640 |
|
|
0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
|
641 |
|
|
}
|
642 |
|
|
}
|
643 |
|
|
|
644 |
|
|
set itk_option(-nodeicon) nodeFolder
|
645 |
|
|
}
|
646 |
|
|
|
647 |
|
|
} else {
|
648 |
|
|
if {[lsearch [image names] $itk_option(-nodeicon)] == -1} {
|
649 |
|
|
error "bad nodeicon option \"$itk_option(-nodeicon)\":\
|
650 |
|
|
should be an existing image"
|
651 |
|
|
}
|
652 |
|
|
}
|
653 |
|
|
}
|
654 |
|
|
|
655 |
|
|
# ------------------------------------------------------------------
|
656 |
|
|
# OPTION: -width
|
657 |
|
|
#
|
658 |
|
|
# Specifies the width of the hierarchy widget as an entire unit.
|
659 |
|
|
# The value may be specified in any of the forms acceptable to
|
660 |
|
|
# Tk_GetPixels. Any additional space needed to display the other
|
661 |
|
|
# components such as labels, margins, and scrollbars force the text
|
662 |
|
|
# to be compressed. A value of zero along with the same value for
|
663 |
|
|
# the height causes the value given for the visibleitems option
|
664 |
|
|
# to be applied which administers geometry constraints in a different
|
665 |
|
|
# manner.
|
666 |
|
|
# ------------------------------------------------------------------
|
667 |
|
|
configbody iwidgets::Hierarchy::width {
|
668 |
|
|
if {$itk_option(-width) != 0} {
|
669 |
|
|
set shell [lindex [grid info $itk_component(clipper)] 1]
|
670 |
|
|
|
671 |
|
|
#
|
672 |
|
|
# Due to a bug in the tk4.2 grid, we have to check the
|
673 |
|
|
# propagation before setting it. Setting it to the same
|
674 |
|
|
# value it already is will cause it to toggle.
|
675 |
|
|
#
|
676 |
|
|
if {[grid propagate $shell]} {
|
677 |
|
|
grid propagate $shell no
|
678 |
|
|
}
|
679 |
|
|
|
680 |
|
|
$itk_component(list) configure -width 1
|
681 |
|
|
$shell configure \
|
682 |
|
|
-width [winfo pixels $shell $itk_option(-width)]
|
683 |
|
|
} else {
|
684 |
|
|
configure -visibleitems $itk_option(-visibleitems)
|
685 |
|
|
}
|
686 |
|
|
}
|
687 |
|
|
|
688 |
|
|
# ------------------------------------------------------------------
|
689 |
|
|
# OPTION: -height
|
690 |
|
|
#
|
691 |
|
|
# Specifies the height of the hierarchy widget as an entire unit.
|
692 |
|
|
# The value may be specified in any of the forms acceptable to
|
693 |
|
|
# Tk_GetPixels. Any additional space needed to display the other
|
694 |
|
|
# components such as labels, margins, and scrollbars force the text
|
695 |
|
|
# to be compressed. A value of zero along with the same value for
|
696 |
|
|
# the width causes the value given for the visibleitems option
|
697 |
|
|
# to be applied which administers geometry constraints in a different
|
698 |
|
|
# manner.
|
699 |
|
|
# ------------------------------------------------------------------
|
700 |
|
|
configbody iwidgets::Hierarchy::height {
|
701 |
|
|
if {$itk_option(-height) != 0} {
|
702 |
|
|
set shell [lindex [grid info $itk_component(clipper)] 1]
|
703 |
|
|
|
704 |
|
|
#
|
705 |
|
|
# Due to a bug in the tk4.2 grid, we have to check the
|
706 |
|
|
# propagation before setting it. Setting it to the same
|
707 |
|
|
# value it already is will cause it to toggle.
|
708 |
|
|
#
|
709 |
|
|
if {[grid propagate $shell]} {
|
710 |
|
|
grid propagate $shell no
|
711 |
|
|
}
|
712 |
|
|
|
713 |
|
|
$itk_component(list) configure -height 1
|
714 |
|
|
$shell configure \
|
715 |
|
|
-height [winfo pixels $shell $itk_option(-height)]
|
716 |
|
|
} else {
|
717 |
|
|
configure -visibleitems $itk_option(-visibleitems)
|
718 |
|
|
}
|
719 |
|
|
}
|
720 |
|
|
|
721 |
|
|
# ------------------------------------------------------------------
|
722 |
|
|
# OPTION: -visibleitems
|
723 |
|
|
#
|
724 |
|
|
# Specified the widthxheight in characters and lines for the text.
|
725 |
|
|
# This option is only administered if the width and height options
|
726 |
|
|
# are both set to zero, otherwise they take precedence. With the
|
727 |
|
|
# visibleitems option engaged, geometry constraints are maintained
|
728 |
|
|
# only on the text. The size of the other components such as
|
729 |
|
|
# labels, margins, and scroll bars, are additive and independent,
|
730 |
|
|
# effecting the overall size of the scrolled text. In contrast,
|
731 |
|
|
# should the width and height options have non zero values, they
|
732 |
|
|
# are applied to the scrolled text as a whole. The text is
|
733 |
|
|
# compressed or expanded to maintain the geometry constraints.
|
734 |
|
|
# ------------------------------------------------------------------
|
735 |
|
|
configbody iwidgets::Hierarchy::visibleitems {
|
736 |
|
|
if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} {
|
737 |
|
|
if {($itk_option(-width) == 0) && \
|
738 |
|
|
($itk_option(-height) == 0)} {
|
739 |
|
|
set chars [lindex [split $itk_option(-visibleitems) x] 0]
|
740 |
|
|
set lines [lindex [split $itk_option(-visibleitems) x] 1]
|
741 |
|
|
|
742 |
|
|
set shell [lindex [grid info $itk_component(clipper)] 1]
|
743 |
|
|
|
744 |
|
|
#
|
745 |
|
|
# Due to a bug in the tk4.2 grid, we have to check the
|
746 |
|
|
# propagation before setting it. Setting it to the same
|
747 |
|
|
# value it already is will cause it to toggle.
|
748 |
|
|
#
|
749 |
|
|
if {! [grid propagate $shell]} {
|
750 |
|
|
grid propagate $shell yes
|
751 |
|
|
}
|
752 |
|
|
|
753 |
|
|
$itk_component(list) configure -width $chars -height $lines
|
754 |
|
|
}
|
755 |
|
|
|
756 |
|
|
} else {
|
757 |
|
|
error "bad visibleitems option\
|
758 |
|
|
\"$itk_option(-visibleitems)\": should be\
|
759 |
|
|
widthxheight"
|
760 |
|
|
}
|
761 |
|
|
}
|
762 |
|
|
|
763 |
|
|
# ------------------------------------------------------------------
|
764 |
|
|
# PUBLIC METHODS
|
765 |
|
|
# ------------------------------------------------------------------
|
766 |
|
|
|
767 |
|
|
# ----------------------------------------------------------------------
|
768 |
|
|
# PUBLIC METHOD: clear
|
769 |
|
|
#
|
770 |
|
|
# Removes all items from the display including all tags and icons.
|
771 |
|
|
# The display will remain empty until the -filter or -querycommand
|
772 |
|
|
# options are set.
|
773 |
|
|
# ----------------------------------------------------------------------
|
774 |
|
|
body iwidgets::Hierarchy::clear {} {
|
775 |
|
|
$itk_component(list) configure -state normal -cursor watch
|
776 |
|
|
$itk_component(list) delete 1.0 end
|
777 |
|
|
$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
|
778 |
|
|
|
779 |
|
|
catch {unset _nodes}
|
780 |
|
|
catch {unset _text}
|
781 |
|
|
catch {unset _tags}
|
782 |
|
|
catch {unset _icons}
|
783 |
|
|
catch {unset _states}
|
784 |
|
|
catch {unset _images}
|
785 |
|
|
catch {unset _indents}
|
786 |
|
|
|
787 |
|
|
return
|
788 |
|
|
}
|
789 |
|
|
|
790 |
|
|
# ----------------------------------------------------------------------
|
791 |
|
|
# PUBLIC METHOD: selection option ?uid uid...?
|
792 |
|
|
#
|
793 |
|
|
# Handles all operations controlling selections in the hierarchy.
|
794 |
|
|
# Selections may be cleared, added, removed, or queried. The add and
|
795 |
|
|
# remove options accept a series of unique ids.
|
796 |
|
|
# ----------------------------------------------------------------------
|
797 |
|
|
body iwidgets::Hierarchy::selection {op args} {
|
798 |
|
|
switch -- $op {
|
799 |
|
|
clear {
|
800 |
|
|
$itk_component(list) tag remove hilite 1.0 end
|
801 |
|
|
catch {unset _selected}
|
802 |
|
|
return
|
803 |
|
|
}
|
804 |
|
|
add {
|
805 |
|
|
foreach node $args {
|
806 |
|
|
set _selected($node) 1
|
807 |
|
|
catch {
|
808 |
|
|
$itk_component(list) tag add hilite \
|
809 |
|
|
"$node.first" "$node.last"
|
810 |
|
|
}
|
811 |
|
|
}
|
812 |
|
|
}
|
813 |
|
|
remove {
|
814 |
|
|
foreach node $args {
|
815 |
|
|
catch {
|
816 |
|
|
unset _selected($node)
|
817 |
|
|
$itk_component(list) tag remove hilite \
|
818 |
|
|
"$node.first" "$node.last"
|
819 |
|
|
}
|
820 |
|
|
}
|
821 |
|
|
}
|
822 |
|
|
get {
|
823 |
|
|
return [array names _selected]
|
824 |
|
|
}
|
825 |
|
|
default {
|
826 |
|
|
error "bad selection operation \"$op\":\
|
827 |
|
|
should be add, remove, clear or get"
|
828 |
|
|
}
|
829 |
|
|
}
|
830 |
|
|
}
|
831 |
|
|
|
832 |
|
|
# ----------------------------------------------------------------------
|
833 |
|
|
# PUBLIC METHOD: mark option ?arg arg...?
|
834 |
|
|
#
|
835 |
|
|
# Handles all operations controlling marks in the hierarchy. Marks may
|
836 |
|
|
# be cleared, added, removed, or queried. The add and remove options
|
837 |
|
|
# accept a series of unique ids.
|
838 |
|
|
# ----------------------------------------------------------------------
|
839 |
|
|
body iwidgets::Hierarchy::mark {op args} {
|
840 |
|
|
switch -- $op {
|
841 |
|
|
clear {
|
842 |
|
|
$itk_component(list) tag remove lowlite 1.0 end
|
843 |
|
|
catch {unset _marked}
|
844 |
|
|
return
|
845 |
|
|
}
|
846 |
|
|
add {
|
847 |
|
|
foreach node $args {
|
848 |
|
|
set _marked($node) 1
|
849 |
|
|
catch {
|
850 |
|
|
$itk_component(list) tag add lowlite \
|
851 |
|
|
"$node.first" "$node.last"
|
852 |
|
|
}
|
853 |
|
|
}
|
854 |
|
|
}
|
855 |
|
|
remove {
|
856 |
|
|
foreach node $args {
|
857 |
|
|
catch {
|
858 |
|
|
unset _marked($node)
|
859 |
|
|
$itk_component(list) tag remove lowlite \
|
860 |
|
|
"$node.first" "$node.last"
|
861 |
|
|
}
|
862 |
|
|
}
|
863 |
|
|
}
|
864 |
|
|
get {
|
865 |
|
|
return [array names _marked]
|
866 |
|
|
}
|
867 |
|
|
default {
|
868 |
|
|
error "bad mark operation \"$op\":\
|
869 |
|
|
should be add, remove, clear or get"
|
870 |
|
|
}
|
871 |
|
|
}
|
872 |
|
|
}
|
873 |
|
|
|
874 |
|
|
# ----------------------------------------------------------------------
|
875 |
|
|
# PUBLIC METHOD: current
|
876 |
|
|
#
|
877 |
|
|
# Returns the node that was most recently selected by the right mouse
|
878 |
|
|
# button when the item menu was posted. Usually used by the code
|
879 |
|
|
# in the item menu to figure out what item is being manipulated.
|
880 |
|
|
# ----------------------------------------------------------------------
|
881 |
|
|
body iwidgets::Hierarchy::current {} {
|
882 |
|
|
return $_posted
|
883 |
|
|
}
|
884 |
|
|
|
885 |
|
|
# ----------------------------------------------------------------------
|
886 |
|
|
# PUBLIC METHOD: expand node
|
887 |
|
|
#
|
888 |
|
|
# Expands the hierarchy beneath the specified node. Since this can take
|
889 |
|
|
# a moment for large hierarchies, the cursor will be changed to a watch
|
890 |
|
|
# during the expansion.
|
891 |
|
|
# ----------------------------------------------------------------------
|
892 |
|
|
body iwidgets::Hierarchy::expand {node} {
|
893 |
|
|
if {! [info exists _states($node)]} {
|
894 |
|
|
error "bad expand node argument: \"$node\", the node doesn't exist"
|
895 |
|
|
}
|
896 |
|
|
|
897 |
|
|
if {!$_states($node) && \
|
898 |
|
|
(([lsearch $_tags($node) branch] != -1) || \
|
899 |
|
|
([llength [_contents $node]] > 0))} {
|
900 |
|
|
$itk_component(list) configure -state normal -cursor watch
|
901 |
|
|
update
|
902 |
|
|
|
903 |
|
|
#
|
904 |
|
|
# Get the indentation level for the node.
|
905 |
|
|
#
|
906 |
|
|
set indent $_indents($node)
|
907 |
|
|
|
908 |
|
|
set _markers ""
|
909 |
|
|
$itk_component(list) mark set insert "$node:start"
|
910 |
|
|
_drawLevel $node $indent
|
911 |
|
|
|
912 |
|
|
#
|
913 |
|
|
# Following the draw, all our markers need adjusting.
|
914 |
|
|
#
|
915 |
|
|
foreach {name index} $_markers {
|
916 |
|
|
$itk_component(list) mark set $name $index
|
917 |
|
|
}
|
918 |
|
|
|
919 |
|
|
#
|
920 |
|
|
# Set the image to be the open icon, denote the new state,
|
921 |
|
|
# and set the cursor back to normal along with the state.
|
922 |
|
|
#
|
923 |
|
|
$_images($node) configure -image $itk_option(-openicon)
|
924 |
|
|
|
925 |
|
|
set _states($node) 1
|
926 |
|
|
|
927 |
|
|
$itk_component(list) configure -state disabled \
|
928 |
|
|
-cursor $itk_option(-cursor)
|
929 |
|
|
}
|
930 |
|
|
}
|
931 |
|
|
|
932 |
|
|
# ----------------------------------------------------------------------
|
933 |
|
|
# PUBLIC METHOD: collapse node
|
934 |
|
|
#
|
935 |
|
|
# Collapses the hierarchy beneath the specified node. Since this can
|
936 |
|
|
# take a moment for large hierarchies, the cursor will be changed to a
|
937 |
|
|
# watch during the expansion.
|
938 |
|
|
# ----------------------------------------------------------------------
|
939 |
|
|
body iwidgets::Hierarchy::collapse {node} {
|
940 |
|
|
if {! [info exists _states($node)]} {
|
941 |
|
|
error "bad collapse node argument: \"$node\", the node doesn't exist"
|
942 |
|
|
}
|
943 |
|
|
|
944 |
|
|
if {[info exists _states($node)] && $_states($node) && \
|
945 |
|
|
(([lsearch $_tags($node) branch] != -1) || \
|
946 |
|
|
([llength [_contents $node]] > 0))} {
|
947 |
|
|
$itk_component(list) configure -state normal -cursor watch
|
948 |
|
|
update
|
949 |
|
|
|
950 |
|
|
_deselectSubNodes $node
|
951 |
|
|
|
952 |
|
|
$itk_component(list) delete "$node:start" "$node:end"
|
953 |
|
|
|
954 |
|
|
catch {$_images($node) configure -image $itk_option(-closedicon)}
|
955 |
|
|
|
956 |
|
|
set _states($node) 0
|
957 |
|
|
|
958 |
|
|
$itk_component(list) configure -state disabled \
|
959 |
|
|
-cursor $itk_option(-cursor)
|
960 |
|
|
}
|
961 |
|
|
}
|
962 |
|
|
|
963 |
|
|
# ----------------------------------------------------------------------
|
964 |
|
|
# PUBLIC METHOD: toggle node
|
965 |
|
|
#
|
966 |
|
|
# Toggles the hierarchy beneath the specified node. If the hierarchy
|
967 |
|
|
# is currently expanded, then it is collapsed, and vice-versa.
|
968 |
|
|
# ----------------------------------------------------------------------
|
969 |
|
|
body iwidgets::Hierarchy::toggle {node} {
|
970 |
|
|
if {! [info exists _states($node)]} {
|
971 |
|
|
error "bad toggle node argument: \"$node\", the node doesn't exist"
|
972 |
|
|
}
|
973 |
|
|
|
974 |
|
|
if {$_states($node)} {
|
975 |
|
|
collapse $node
|
976 |
|
|
} else {
|
977 |
|
|
expand $node
|
978 |
|
|
}
|
979 |
|
|
}
|
980 |
|
|
|
981 |
|
|
# ----------------------------------------------------------------------
|
982 |
|
|
# PUBLIC METHOD: prune node
|
983 |
|
|
#
|
984 |
|
|
# Removes a particular node from the hierarchy.
|
985 |
|
|
# ----------------------------------------------------------------------
|
986 |
|
|
body iwidgets::Hierarchy::prune {node} {
|
987 |
|
|
#
|
988 |
|
|
# While we're working, change the state and cursor so we can
|
989 |
|
|
# edit the text and give a busy visual clue.
|
990 |
|
|
#
|
991 |
|
|
$itk_component(list) configure -state normal -cursor watch
|
992 |
|
|
|
993 |
|
|
#
|
994 |
|
|
# Recursively delete all the subnode information from our internal
|
995 |
|
|
# arrays and remove all the tags.
|
996 |
|
|
#
|
997 |
|
|
_deleteNodeInfo $node
|
998 |
|
|
|
999 |
|
|
#
|
1000 |
|
|
# If the mark $node:end exists then the node has decendents so
|
1001 |
|
|
# so we'll remove from the mark $node:start to $node:end in order
|
1002 |
|
|
# to delete all the subnodes below it in the text.
|
1003 |
|
|
#
|
1004 |
|
|
if {[lsearch [$itk_component(list) mark names] $node:end] != -1} {
|
1005 |
|
|
$itk_component(list) delete $node:start $node:end
|
1006 |
|
|
$itk_component(list) mark unset $node:end
|
1007 |
|
|
}
|
1008 |
|
|
|
1009 |
|
|
#
|
1010 |
|
|
# Next we need to remove the node itself. Using the ranges for
|
1011 |
|
|
# its tag we'll remove it from line start to the end plus one
|
1012 |
|
|
# character which takes us to the start of the next node.
|
1013 |
|
|
#
|
1014 |
|
|
foreach {start end} [$itk_component(list) tag ranges $node] {
|
1015 |
|
|
$itk_component(list) delete "$start linestart" "$end + 1 char"
|
1016 |
|
|
}
|
1017 |
|
|
|
1018 |
|
|
#
|
1019 |
|
|
# Delete the tag for this node.
|
1020 |
|
|
#
|
1021 |
|
|
$itk_component(list) tag delete $node
|
1022 |
|
|
|
1023 |
|
|
#
|
1024 |
|
|
# The node must be removed from the list of subnodes for its parent.
|
1025 |
|
|
# We don't really have a clean way to do upwards referencing, so
|
1026 |
|
|
# the dirty way will have to do. We'll cycle through each node
|
1027 |
|
|
# and if this node is in its list of subnodes, we'll remove it.
|
1028 |
|
|
#
|
1029 |
|
|
foreach uid [array names _nodes] {
|
1030 |
|
|
if {[set index [lsearch $_nodes($uid) $node]] != -1} {
|
1031 |
|
|
set _nodes($uid) [lreplace $_nodes($uid) $index $index]
|
1032 |
|
|
}
|
1033 |
|
|
}
|
1034 |
|
|
|
1035 |
|
|
#
|
1036 |
|
|
# We're done, so change the state and cursor back to their
|
1037 |
|
|
# original values.
|
1038 |
|
|
#
|
1039 |
|
|
$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
|
1040 |
|
|
}
|
1041 |
|
|
|
1042 |
|
|
# ----------------------------------------------------------------------
|
1043 |
|
|
# PUBLIC METHOD: draw ?when?
|
1044 |
|
|
#
|
1045 |
|
|
# Performs a complete draw of the entire hierarchy.
|
1046 |
|
|
# ----------------------------------------------------------------------
|
1047 |
|
|
body iwidgets::Hierarchy::draw {{when -now}} {
|
1048 |
|
|
if {$when == "-eventually"} {
|
1049 |
|
|
if {$_pending == ""} {
|
1050 |
|
|
set _pending [after idle [code $this draw -now]]
|
1051 |
|
|
}
|
1052 |
|
|
return
|
1053 |
|
|
} elseif {$when != "-now"} {
|
1054 |
|
|
error "bad when option \"$when\": should be -eventually or -now"
|
1055 |
|
|
}
|
1056 |
|
|
$itk_component(list) configure -state normal -cursor watch
|
1057 |
|
|
update
|
1058 |
|
|
|
1059 |
|
|
$itk_component(list) delete 1.0 end
|
1060 |
|
|
catch {unset _images}
|
1061 |
|
|
set _markers ""
|
1062 |
|
|
|
1063 |
|
|
_drawLevel "" ""
|
1064 |
|
|
|
1065 |
|
|
foreach {name index} $_markers {
|
1066 |
|
|
$itk_component(list) mark set $name $index
|
1067 |
|
|
}
|
1068 |
|
|
|
1069 |
|
|
$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
|
1070 |
|
|
set _pending ""
|
1071 |
|
|
}
|
1072 |
|
|
|
1073 |
|
|
# ----------------------------------------------------------------------
|
1074 |
|
|
# PUBLIC METHOD: refresh node
|
1075 |
|
|
#
|
1076 |
|
|
# Performs a redraw of a specific node. If that node is currently
|
1077 |
|
|
# not visible, then no action is taken.
|
1078 |
|
|
# ----------------------------------------------------------------------
|
1079 |
|
|
body iwidgets::Hierarchy::refresh {node} {
|
1080 |
|
|
if {! [info exists _nodes($node)]} {
|
1081 |
|
|
error "bad refresh node argument: \"$node\", the node doesn't exist"
|
1082 |
|
|
}
|
1083 |
|
|
|
1084 |
|
|
|
1085 |
|
|
if {! $_states($node)} {return}
|
1086 |
|
|
|
1087 |
|
|
foreach parent [_getHeritage $node] {
|
1088 |
|
|
if {! $_states($parent)} {return}
|
1089 |
|
|
}
|
1090 |
|
|
|
1091 |
|
|
$itk_component(list) configure -state normal -cursor watch
|
1092 |
|
|
$itk_component(list) delete $node:start $node:end
|
1093 |
|
|
|
1094 |
|
|
set _markers ""
|
1095 |
|
|
$itk_component(list) mark set insert "$node:start"
|
1096 |
|
|
set indent $_indents($node)
|
1097 |
|
|
|
1098 |
|
|
_drawLevel $node $indent
|
1099 |
|
|
|
1100 |
|
|
foreach {name index} $_markers {
|
1101 |
|
|
$itk_component(list) mark set $name $index
|
1102 |
|
|
}
|
1103 |
|
|
|
1104 |
|
|
$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
|
1105 |
|
|
}
|
1106 |
|
|
|
1107 |
|
|
# ------------------------------------------------------------------
|
1108 |
|
|
# THIN WRAPPED TEXT METHODS:
|
1109 |
|
|
#
|
1110 |
|
|
# The following methods are thin wraps of standard text methods.
|
1111 |
|
|
# Consult the Tk text man pages for functionallity and argument
|
1112 |
|
|
# documentation.
|
1113 |
|
|
# ------------------------------------------------------------------
|
1114 |
|
|
|
1115 |
|
|
# ------------------------------------------------------------------
|
1116 |
|
|
# PUBLIC METHOD: bbox index
|
1117 |
|
|
#
|
1118 |
|
|
# Returns four element list describing the bounding box for the list
|
1119 |
|
|
# item at index
|
1120 |
|
|
# ------------------------------------------------------------------
|
1121 |
|
|
body iwidgets::Hierarchy::bbox {index} {
|
1122 |
|
|
return [$itk_component(list) bbox $index]
|
1123 |
|
|
}
|
1124 |
|
|
|
1125 |
|
|
# ------------------------------------------------------------------
|
1126 |
|
|
# PUBLIC METHOD compare index1 op index2
|
1127 |
|
|
#
|
1128 |
|
|
# Compare indices according to relational operator.
|
1129 |
|
|
# ------------------------------------------------------------------
|
1130 |
|
|
body iwidgets::Hierarchy::compare {index1 op index2} {
|
1131 |
|
|
return [$itk_component(list) compare $index1 $op $index2]
|
1132 |
|
|
}
|
1133 |
|
|
|
1134 |
|
|
# ------------------------------------------------------------------
|
1135 |
|
|
# PUBLIC METHOD delete first ?last?
|
1136 |
|
|
#
|
1137 |
|
|
# Delete a range of characters from the text.
|
1138 |
|
|
# ------------------------------------------------------------------
|
1139 |
|
|
body iwidgets::Hierarchy::delete {first {last {}}} {
|
1140 |
|
|
$itk_component(list) configure -state normal -cursor watch
|
1141 |
|
|
$itk_component(list) delete $first $last
|
1142 |
|
|
$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
|
1143 |
|
|
}
|
1144 |
|
|
|
1145 |
|
|
# ------------------------------------------------------------------
|
1146 |
|
|
# PUBLIC METHOD dump ?switches? index1 ?index2?
|
1147 |
|
|
#
|
1148 |
|
|
# Returns information about the contents of the text widget from
|
1149 |
|
|
# index1 to index2.
|
1150 |
|
|
# ------------------------------------------------------------------
|
1151 |
|
|
body iwidgets::Hierarchy::dump {args} {
|
1152 |
|
|
return [eval $itk_component(list) dump $args]
|
1153 |
|
|
}
|
1154 |
|
|
|
1155 |
|
|
# ------------------------------------------------------------------
|
1156 |
|
|
# PUBLIC METHOD dlineinfo index
|
1157 |
|
|
#
|
1158 |
|
|
# Returns a five element list describing the area occupied by the
|
1159 |
|
|
# display line containing index.
|
1160 |
|
|
# ------------------------------------------------------------------
|
1161 |
|
|
body iwidgets::Hierarchy::dlineinfo {index} {
|
1162 |
|
|
return [$itk_component(list) dlineinfo $index]
|
1163 |
|
|
}
|
1164 |
|
|
|
1165 |
|
|
# ------------------------------------------------------------------
|
1166 |
|
|
# PUBLIC METHOD get index1 ?index2?
|
1167 |
|
|
#
|
1168 |
|
|
# Return text from start index to end index.
|
1169 |
|
|
# ------------------------------------------------------------------
|
1170 |
|
|
body iwidgets::Hierarchy::get {index1 {index2 {}}} {
|
1171 |
|
|
return [$itk_component(list) get $index1 $index2]
|
1172 |
|
|
}
|
1173 |
|
|
|
1174 |
|
|
# ------------------------------------------------------------------
|
1175 |
|
|
# PUBLIC METHOD index index
|
1176 |
|
|
#
|
1177 |
|
|
# Return position corresponding to index.
|
1178 |
|
|
# ------------------------------------------------------------------
|
1179 |
|
|
body iwidgets::Hierarchy::index {index} {
|
1180 |
|
|
return [$itk_component(list) index $index]
|
1181 |
|
|
}
|
1182 |
|
|
|
1183 |
|
|
# ------------------------------------------------------------------
|
1184 |
|
|
# PUBLIC METHOD insert index chars ?tagList?
|
1185 |
|
|
#
|
1186 |
|
|
# Insert text at index.
|
1187 |
|
|
# ------------------------------------------------------------------
|
1188 |
|
|
body iwidgets::Hierarchy::insert {args} {
|
1189 |
|
|
$itk_component(list) configure -state normal -cursor watch
|
1190 |
|
|
eval $itk_component(list) insert $args
|
1191 |
|
|
$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
|
1192 |
|
|
}
|
1193 |
|
|
|
1194 |
|
|
# ------------------------------------------------------------------
|
1195 |
|
|
# PUBLIC METHOD scan option args
|
1196 |
|
|
#
|
1197 |
|
|
# Implements scanning on texts.
|
1198 |
|
|
# ------------------------------------------------------------------
|
1199 |
|
|
body iwidgets::Hierarchy::scan {option args} {
|
1200 |
|
|
eval $itk_component(list) scan $option $args
|
1201 |
|
|
}
|
1202 |
|
|
|
1203 |
|
|
# ------------------------------------------------------------------
|
1204 |
|
|
# PUBLIC METHOD search ?switches? pattern index ?varName?
|
1205 |
|
|
#
|
1206 |
|
|
# Searches the text for characters matching a pattern.
|
1207 |
|
|
# ------------------------------------------------------------------
|
1208 |
|
|
body iwidgets::Hierarchy::search {args} {
|
1209 |
|
|
return [eval $itk_component(list) search $args]
|
1210 |
|
|
}
|
1211 |
|
|
|
1212 |
|
|
# ------------------------------------------------------------------
|
1213 |
|
|
# PUBLIC METHOD see index
|
1214 |
|
|
#
|
1215 |
|
|
# Adjusts the view in the window so the character at index is
|
1216 |
|
|
# visible.
|
1217 |
|
|
# ------------------------------------------------------------------
|
1218 |
|
|
body iwidgets::Hierarchy::see {index} {
|
1219 |
|
|
$itk_component(list) see $index
|
1220 |
|
|
}
|
1221 |
|
|
|
1222 |
|
|
# ------------------------------------------------------------------
|
1223 |
|
|
# PUBLIC METHOD tag option ?arg arg ...?
|
1224 |
|
|
#
|
1225 |
|
|
# Manipulate tags dependent on options.
|
1226 |
|
|
# ------------------------------------------------------------------
|
1227 |
|
|
body iwidgets::Hierarchy::tag {op args} {
|
1228 |
|
|
return [eval $itk_component(list) tag $op $args]
|
1229 |
|
|
}
|
1230 |
|
|
|
1231 |
|
|
# ------------------------------------------------------------------
|
1232 |
|
|
# PUBLIC METHOD window option ?arg arg ...?
|
1233 |
|
|
#
|
1234 |
|
|
# Manipulate embedded windows.
|
1235 |
|
|
# ------------------------------------------------------------------
|
1236 |
|
|
body iwidgets::Hierarchy::window {option args} {
|
1237 |
|
|
return [eval $itk_component(list) window $option $args]
|
1238 |
|
|
}
|
1239 |
|
|
|
1240 |
|
|
# ----------------------------------------------------------------------
|
1241 |
|
|
# PUBLIC METHOD: xview args
|
1242 |
|
|
#
|
1243 |
|
|
# Thin wrap of the text widget's xview command.
|
1244 |
|
|
# ----------------------------------------------------------------------
|
1245 |
|
|
body iwidgets::Hierarchy::xview {args} {
|
1246 |
|
|
return [eval itk_component(list) xview $args]
|
1247 |
|
|
}
|
1248 |
|
|
|
1249 |
|
|
# ----------------------------------------------------------------------
|
1250 |
|
|
# PUBLIC METHOD: yview args
|
1251 |
|
|
#
|
1252 |
|
|
# Thin wrap of the text widget's yview command.
|
1253 |
|
|
# ----------------------------------------------------------------------
|
1254 |
|
|
body iwidgets::Hierarchy::yview {args} {
|
1255 |
|
|
return [eval $itk_component(list) yview $args]
|
1256 |
|
|
}
|
1257 |
|
|
|
1258 |
|
|
# ------------------------------------------------------------------
|
1259 |
|
|
# PROTECTED METHODS
|
1260 |
|
|
# ------------------------------------------------------------------
|
1261 |
|
|
|
1262 |
|
|
# ----------------------------------------------------------------------
|
1263 |
|
|
# PROTECTED METHOD: _drawLevel node indent
|
1264 |
|
|
#
|
1265 |
|
|
# Used internally by draw to draw one level of the hierarchy.
|
1266 |
|
|
# Draws all of the nodes under node, using the indent string to
|
1267 |
|
|
# indent nodes.
|
1268 |
|
|
# ----------------------------------------------------------------------
|
1269 |
|
|
body iwidgets::Hierarchy::_drawLevel {node indent} {
|
1270 |
|
|
lappend _markers "$node:start" [$itk_component(list) index insert]
|
1271 |
|
|
set bg [$itk_component(list) cget -background]
|
1272 |
|
|
|
1273 |
|
|
#
|
1274 |
|
|
# Obtain the list of subnodes for this node and cycle through
|
1275 |
|
|
# each one displaying it in the hierarchy.
|
1276 |
|
|
#
|
1277 |
|
|
foreach child [_contents $node] {
|
1278 |
|
|
set _images($child) "$itk_component(list).hicon[incr _hcounter]"
|
1279 |
|
|
|
1280 |
|
|
if {![info exists _states($child)]} {
|
1281 |
|
|
set _states($child) $itk_option(-expanded)
|
1282 |
|
|
}
|
1283 |
|
|
|
1284 |
|
|
#
|
1285 |
|
|
# Check the user tags to see if they have been kind enough
|
1286 |
|
|
# to tell us ahead of time what type of node we are dealing
|
1287 |
|
|
# with branch or leaf. If they neglected to do so, then
|
1288 |
|
|
# get the contents of the child node to see if it has children
|
1289 |
|
|
# itself.
|
1290 |
|
|
#
|
1291 |
|
|
set display 0
|
1292 |
|
|
|
1293 |
|
|
if {[lsearch $_tags($child) leaf] != -1} {
|
1294 |
|
|
set type leaf
|
1295 |
|
|
} elseif {[lsearch $_tags($child) branch] != -1} {
|
1296 |
|
|
set type branch
|
1297 |
|
|
} else {
|
1298 |
|
|
if {[llength [_contents $child]] == 0} {
|
1299 |
|
|
set type leaf
|
1300 |
|
|
} else {
|
1301 |
|
|
set type branch
|
1302 |
|
|
}
|
1303 |
|
|
}
|
1304 |
|
|
|
1305 |
|
|
#
|
1306 |
|
|
# Now that we know the type of node, branch or leaf, we know
|
1307 |
|
|
# the type of icon to use.
|
1308 |
|
|
#
|
1309 |
|
|
if {$type == "leaf"} {
|
1310 |
|
|
set icon $itk_option(-nodeicon)
|
1311 |
|
|
eval $_filterCode
|
1312 |
|
|
} else {
|
1313 |
|
|
if {$_states($child)} {
|
1314 |
|
|
set icon $itk_option(-openicon)
|
1315 |
|
|
} else {
|
1316 |
|
|
set icon $itk_option(-closedicon)
|
1317 |
|
|
}
|
1318 |
|
|
set display 1
|
1319 |
|
|
}
|
1320 |
|
|
|
1321 |
|
|
#
|
1322 |
|
|
# If display is set then we're going to be drawing this node.
|
1323 |
|
|
# Save off the indentation level for this node and do the indent.
|
1324 |
|
|
#
|
1325 |
|
|
if {$display} {
|
1326 |
|
|
set _indents($child) "$indent\t"
|
1327 |
|
|
$itk_component(list) insert insert $indent
|
1328 |
|
|
|
1329 |
|
|
#
|
1330 |
|
|
# Add the branch or leaf icon and setup a binding to toggle
|
1331 |
|
|
# its expanded/collapsed state.
|
1332 |
|
|
#
|
1333 |
|
|
label $_images($child) -image $icon -background $bg
|
1334 |
|
|
bind $_images($child) [code $this toggle $child]
|
1335 |
|
|
$itk_component(list) window create insert -window $_images($child)
|
1336 |
|
|
|
1337 |
|
|
#
|
1338 |
|
|
# If any user icons exist then draw them as well. The little
|
1339 |
|
|
# regexp is just to check and see if they've passed in a
|
1340 |
|
|
# command which needs to be evaluated as opposed to just
|
1341 |
|
|
# a variable. Also, attach a binding to call them if their
|
1342 |
|
|
# icon is selected.
|
1343 |
|
|
#
|
1344 |
|
|
if {[info exists _icons($child)]} {
|
1345 |
|
|
foreach image $_icons($child) {
|
1346 |
|
|
set wid "$itk_component(list).uicon[incr _ucounter]"
|
1347 |
|
|
|
1348 |
|
|
if {[regexp {\[.*\]} $image]} {
|
1349 |
|
|
eval label $wid -image $image -background $bg
|
1350 |
|
|
} else {
|
1351 |
|
|
label $wid -image $image -background $bg
|
1352 |
|
|
}
|
1353 |
|
|
|
1354 |
|
|
bind $wid \
|
1355 |
|
|
[code $this _iconSelect $child $image]
|
1356 |
|
|
$itk_component(list) window create insert -window $wid
|
1357 |
|
|
}
|
1358 |
|
|
}
|
1359 |
|
|
|
1360 |
|
|
#
|
1361 |
|
|
# Create the list of tags to be applied to the text. Start
|
1362 |
|
|
# out with a tag of "info" and append "hilite" if the node
|
1363 |
|
|
# is currently selected, finally add the tags given by the
|
1364 |
|
|
# user.
|
1365 |
|
|
#
|
1366 |
|
|
set texttags [list "info" $child]
|
1367 |
|
|
|
1368 |
|
|
if {[info exists _selected($child)]} {
|
1369 |
|
|
lappend texttags hilite
|
1370 |
|
|
}
|
1371 |
|
|
|
1372 |
|
|
foreach tag $_tags($child) {
|
1373 |
|
|
lappend texttags $tag
|
1374 |
|
|
}
|
1375 |
|
|
|
1376 |
|
|
#
|
1377 |
|
|
# Insert the text for the node along with the tags and
|
1378 |
|
|
# append to the markers the start of this node. The text
|
1379 |
|
|
# has been broken at newlines into a list. We'll make sure
|
1380 |
|
|
# that each line is at the same indentation position.
|
1381 |
|
|
#
|
1382 |
|
|
set firstline 1
|
1383 |
|
|
foreach line $_text($child) {
|
1384 |
|
|
if {$firstline} {
|
1385 |
|
|
$itk_component(list) insert insert " "
|
1386 |
|
|
} else {
|
1387 |
|
|
$itk_component(list) insert insert "$indent\t"
|
1388 |
|
|
}
|
1389 |
|
|
|
1390 |
|
|
$itk_component(list) insert insert $line $texttags "\n"
|
1391 |
|
|
set firstline 0
|
1392 |
|
|
}
|
1393 |
|
|
|
1394 |
|
|
lappend _markers "$child:start" [$itk_component(list) index insert]
|
1395 |
|
|
|
1396 |
|
|
#
|
1397 |
|
|
# If the state of the node is open, proceed to draw the next
|
1398 |
|
|
# node below it in the hierarchy.
|
1399 |
|
|
#
|
1400 |
|
|
if {$_states($child)} {
|
1401 |
|
|
_drawLevel $child "$indent\t"
|
1402 |
|
|
}
|
1403 |
|
|
}
|
1404 |
|
|
}
|
1405 |
|
|
|
1406 |
|
|
lappend _markers "$node:end" [$itk_component(list) index insert]
|
1407 |
|
|
}
|
1408 |
|
|
|
1409 |
|
|
# ----------------------------------------------------------------------
|
1410 |
|
|
# PROTECTED METHOD: _contents uid
|
1411 |
|
|
#
|
1412 |
|
|
# Used internally to get the contents of a particular node. If this
|
1413 |
|
|
# is the first time the node has been seen or the -alwaysquery
|
1414 |
|
|
# option is set, the -querycommand code is executed to query the node
|
1415 |
|
|
# list, and the list is stored until the next time it is needed.
|
1416 |
|
|
#
|
1417 |
|
|
# The querycommand may return not only the list of subnodes for the
|
1418 |
|
|
# node but additional information on the tags and icons to be used.
|
1419 |
|
|
# The return value must be parsed based on the number of elements in
|
1420 |
|
|
# the list where the format is a list of lists:
|
1421 |
|
|
#
|
1422 |
|
|
# {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
|
1423 |
|
|
# ----------------------------------------------------------------------
|
1424 |
|
|
body iwidgets::Hierarchy::_contents {uid} {
|
1425 |
|
|
if {! $itk_option(-alwaysquery) && [info exists _nodes($uid)]} {
|
1426 |
|
|
return $_nodes($uid)
|
1427 |
|
|
}
|
1428 |
|
|
|
1429 |
|
|
#
|
1430 |
|
|
# Substitute any %n's for the node name whose children we're
|
1431 |
|
|
# interested in obtaining.
|
1432 |
|
|
#
|
1433 |
|
|
set cmd $itk_option(-querycommand)
|
1434 |
|
|
regsub -all {%n} $cmd [list $uid] cmd
|
1435 |
|
|
|
1436 |
|
|
set nodeinfolist [uplevel \#0 $cmd]
|
1437 |
|
|
|
1438 |
|
|
#
|
1439 |
|
|
# Cycle through the node information returned by the query
|
1440 |
|
|
# command determining if additional information such as text,
|
1441 |
|
|
# user tags, or user icons have been provided. For text,
|
1442 |
|
|
# break it into a list at any newline characters.
|
1443 |
|
|
#
|
1444 |
|
|
set _nodes($uid) {}
|
1445 |
|
|
|
1446 |
|
|
foreach nodeinfo $nodeinfolist {
|
1447 |
|
|
set subnodeuid [lindex $nodeinfo 0]
|
1448 |
|
|
lappend _nodes($uid) $subnodeuid
|
1449 |
|
|
|
1450 |
|
|
set llen [llength $nodeinfo]
|
1451 |
|
|
|
1452 |
|
|
if {$llen == 0 || $llen > 4} {
|
1453 |
|
|
error "invalid number of elements returned by query\
|
1454 |
|
|
command for node: \"$uid\",\
|
1455 |
|
|
should be uid \[text \[tags \[icons\]\]\]"
|
1456 |
|
|
}
|
1457 |
|
|
|
1458 |
|
|
if {$llen == 1} {
|
1459 |
|
|
set _text($subnodeuid) [split $subnodeuid \n]
|
1460 |
|
|
}
|
1461 |
|
|
if {$llen > 1} {
|
1462 |
|
|
set _text($subnodeuid) [split [lindex $nodeinfo 1] \n]
|
1463 |
|
|
}
|
1464 |
|
|
if {$llen > 2} {
|
1465 |
|
|
set _tags($subnodeuid) [lindex $nodeinfo 2]
|
1466 |
|
|
} else {
|
1467 |
|
|
set _tags($subnodeuid) unknown
|
1468 |
|
|
}
|
1469 |
|
|
if {$llen > 3} {
|
1470 |
|
|
set _icons($subnodeuid) [lindex $nodeinfo 3]
|
1471 |
|
|
}
|
1472 |
|
|
}
|
1473 |
|
|
|
1474 |
|
|
#
|
1475 |
|
|
# Return the list of nodes.
|
1476 |
|
|
#
|
1477 |
|
|
return $_nodes($uid)
|
1478 |
|
|
}
|
1479 |
|
|
|
1480 |
|
|
# ----------------------------------------------------------------------
|
1481 |
|
|
# PROTECTED METHOD: _post x y
|
1482 |
|
|
#
|
1483 |
|
|
# Used internally to post the popup menu at the coordinate (x,y)
|
1484 |
|
|
# relative to the widget. If (x,y) is on an item, then the itemMenu
|
1485 |
|
|
# component is posted. Otherwise, the bgMenu is posted.
|
1486 |
|
|
# ----------------------------------------------------------------------
|
1487 |
|
|
body iwidgets::Hierarchy::_post {x y} {
|
1488 |
|
|
set rx [expr [winfo rootx $itk_component(list)]+$x]
|
1489 |
|
|
set ry [expr [winfo rooty $itk_component(list)]+$y]
|
1490 |
|
|
|
1491 |
|
|
set index [$itk_component(list) index @$x,$y]
|
1492 |
|
|
|
1493 |
|
|
#
|
1494 |
|
|
# The posted variable will hold the list of tags which exist at
|
1495 |
|
|
# this x,y position that will be passed back to the user. They
|
1496 |
|
|
# don't need to know about our internal tags, info, hilite, and
|
1497 |
|
|
# lowlite, so remove them from the list.
|
1498 |
|
|
#
|
1499 |
|
|
set _posted {}
|
1500 |
|
|
|
1501 |
|
|
foreach tag [$itk_component(list) tag names $index] {
|
1502 |
|
|
if {![_isInternalTag $tag]} {
|
1503 |
|
|
lappend _posted $tag
|
1504 |
|
|
}
|
1505 |
|
|
}
|
1506 |
|
|
|
1507 |
|
|
#
|
1508 |
|
|
# If we have tags then do the popup at this position.
|
1509 |
|
|
#
|
1510 |
|
|
if {$_posted != {}} {
|
1511 |
|
|
tk_popup $itk_component(itemMenu) $rx $ry
|
1512 |
|
|
} else {
|
1513 |
|
|
tk_popup $itk_component(bgMenu) $rx $ry
|
1514 |
|
|
}
|
1515 |
|
|
}
|
1516 |
|
|
|
1517 |
|
|
# ----------------------------------------------------------------------
|
1518 |
|
|
# PROTECTED METHOD: _select x y
|
1519 |
|
|
#
|
1520 |
|
|
# Used internally to select an item at the coordinate (x,y) relative
|
1521 |
|
|
# to the widget. The command associated with the -selectcommand
|
1522 |
|
|
# option is execute following % character substitutions. If %n
|
1523 |
|
|
# appears in the command, the selected node is substituted. If %s
|
1524 |
|
|
# appears, a boolean value representing the current selection state
|
1525 |
|
|
# will be substituted.
|
1526 |
|
|
# ----------------------------------------------------------------------
|
1527 |
|
|
body iwidgets::Hierarchy::_select {x y} {
|
1528 |
|
|
if {$itk_option(-selectcommand) != {}} {
|
1529 |
|
|
if {[set seltags [$itk_component(list) tag names @$x,$y]] != {}} {
|
1530 |
|
|
foreach tag $seltags {
|
1531 |
|
|
if {![_isInternalTag $tag]} {
|
1532 |
|
|
lappend node $tag
|
1533 |
|
|
}
|
1534 |
|
|
}
|
1535 |
|
|
|
1536 |
|
|
if {[lsearch $seltags "hilite"] == -1} {
|
1537 |
|
|
set selectstatus 0
|
1538 |
|
|
} else {
|
1539 |
|
|
set selectstatus 1
|
1540 |
|
|
}
|
1541 |
|
|
|
1542 |
|
|
set cmd $itk_option(-selectcommand)
|
1543 |
|
|
regsub -all {%n} $cmd [list $node] cmd
|
1544 |
|
|
regsub -all {%s} $cmd [list $selectstatus] cmd
|
1545 |
|
|
|
1546 |
|
|
uplevel #0 $cmd
|
1547 |
|
|
}
|
1548 |
|
|
}
|
1549 |
|
|
|
1550 |
|
|
return
|
1551 |
|
|
}
|
1552 |
|
|
|
1553 |
|
|
# ----------------------------------------------------------------------
|
1554 |
|
|
# PROTECTED METHOD: _iconSelect node icon
|
1555 |
|
|
#
|
1556 |
|
|
# Used internally to upon selection of user icons. The -iconcommand
|
1557 |
|
|
# is executed after substitution of the node for %n and icon for %i.
|
1558 |
|
|
# ----------------------------------------------------------------------
|
1559 |
|
|
body iwidgets::Hierarchy::_iconSelect {node icon} {
|
1560 |
|
|
set cmd $itk_option(-iconcommand)
|
1561 |
|
|
regsub -all {%n} $cmd [list $node] cmd
|
1562 |
|
|
regsub -all {%i} $cmd [list $icon] cmd
|
1563 |
|
|
|
1564 |
|
|
uplevel \#0 $cmd
|
1565 |
|
|
|
1566 |
|
|
return {}
|
1567 |
|
|
}
|
1568 |
|
|
|
1569 |
|
|
# ----------------------------------------------------------------------
|
1570 |
|
|
# PROTECTED METHOD: _deselectSubNodes uid
|
1571 |
|
|
#
|
1572 |
|
|
# Used internally to recursively deselect all the nodes beneath a
|
1573 |
|
|
# particular node.
|
1574 |
|
|
# ----------------------------------------------------------------------
|
1575 |
|
|
body iwidgets::Hierarchy::_deselectSubNodes {uid} {
|
1576 |
|
|
foreach node $_nodes($uid) {
|
1577 |
|
|
if {[array names _selected $node] != {}} {
|
1578 |
|
|
unset _selected($node)
|
1579 |
|
|
}
|
1580 |
|
|
|
1581 |
|
|
if {[array names _nodes $node] != {}} {
|
1582 |
|
|
_deselectSubNodes $node
|
1583 |
|
|
}
|
1584 |
|
|
}
|
1585 |
|
|
}
|
1586 |
|
|
|
1587 |
|
|
# ----------------------------------------------------------------------
|
1588 |
|
|
# PROTECTED METHOD: _deleteNodeInfo uid
|
1589 |
|
|
#
|
1590 |
|
|
# Used internally to recursively delete all the information about a
|
1591 |
|
|
# node and its decendents.
|
1592 |
|
|
# ----------------------------------------------------------------------
|
1593 |
|
|
body iwidgets::Hierarchy::_deleteNodeInfo {uid} {
|
1594 |
|
|
#
|
1595 |
|
|
# Recursively call ourseleves as we go down the hierarchy beneath
|
1596 |
|
|
# this node.
|
1597 |
|
|
#
|
1598 |
|
|
if {[info exists _nodes($uid)]} {
|
1599 |
|
|
foreach node $_nodes($uid) {
|
1600 |
|
|
if {[array names _nodes $node] != {}} {
|
1601 |
|
|
_deleteNodeInfo $node
|
1602 |
|
|
}
|
1603 |
|
|
}
|
1604 |
|
|
}
|
1605 |
|
|
|
1606 |
|
|
#
|
1607 |
|
|
# Unset any entries in our arrays for the node.
|
1608 |
|
|
#
|
1609 |
|
|
catch {unset _nodes($uid)}
|
1610 |
|
|
catch {unset _text($uid)}
|
1611 |
|
|
catch {unset _tags($uid)}
|
1612 |
|
|
catch {unset _icons($uid)}
|
1613 |
|
|
catch {unset _states($uid)}
|
1614 |
|
|
catch {unset _images($uid)}
|
1615 |
|
|
catch {unset _indents($uid)}
|
1616 |
|
|
}
|
1617 |
|
|
|
1618 |
|
|
# ----------------------------------------------------------------------
|
1619 |
|
|
# PROTECTED METHOD: _getParent uid
|
1620 |
|
|
#
|
1621 |
|
|
# Used internally to determine the parent for a node.
|
1622 |
|
|
# ----------------------------------------------------------------------
|
1623 |
|
|
body iwidgets::Hierarchy::_getParent {uid} {
|
1624 |
|
|
foreach node [array names _nodes] {
|
1625 |
|
|
if {[set index [lsearch $_nodes($node) $uid]] != -1} {
|
1626 |
|
|
return $node
|
1627 |
|
|
}
|
1628 |
|
|
}
|
1629 |
|
|
}
|
1630 |
|
|
|
1631 |
|
|
# ----------------------------------------------------------------------
|
1632 |
|
|
# PROTECTED METHOD: _getHeritage uid
|
1633 |
|
|
#
|
1634 |
|
|
# Used internally to determine the list of parents for a node.
|
1635 |
|
|
# ----------------------------------------------------------------------
|
1636 |
|
|
body iwidgets::Hierarchy::_getHeritage {uid} {
|
1637 |
|
|
set parents {}
|
1638 |
|
|
|
1639 |
|
|
if {[set parent [_getParent $uid]] != {}} {
|
1640 |
|
|
lappend parents $parent
|
1641 |
|
|
}
|
1642 |
|
|
|
1643 |
|
|
return $parents
|
1644 |
|
|
}
|
1645 |
|
|
|
1646 |
|
|
# ----------------------------------------------------------------------
|
1647 |
|
|
# PROTECTED METHOD (could be proc?): _isInternalTag tag
|
1648 |
|
|
#
|
1649 |
|
|
# Used internally to tags not to used for user callback commands
|
1650 |
|
|
# ----------------------------------------------------------------------
|
1651 |
|
|
body iwidgets::Hierarchy::_isInternalTag {tag} {
|
1652 |
|
|
set ii [expr [lsearch -exact {info hilite lowlite unknown} $tag] != -1];
|
1653 |
|
|
return $ii;
|
1654 |
|
|
}
|