iwidgets for itk4

Check-in [66a0503a53]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Initial setup iwidgets 4.1
Timelines: family | ancestors | trunk
Files: files | file ages | folders
SHA1:66a0503a53ed1c6bd09619fcbb6ae6fe3d938398
User & Date: rene 2012-05-24 09:03:46
Context
2012-05-24
09:03
Initial setup iwidgets 4.1 Leaf check-in: 66a0503a53 user: rene tags: trunk
08:51
initial empty check-in check-in: 6b14c28604 user: rene tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added README.

























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
iwidgets 4.1 -- iwidgets for itk4
=================================

Slightly modified iwidgets implementation for itk4.
For changes see the iwidgets.patch file.

Sources
-------

The itk repository is hosted at:
  http://chiselapp.com/user/rene/repository/itk/
A slightly modified iwidgets (see iwidgets.patch) is hosted at:
  http://chiselapp.com/user/rene/repository/iwidgets/

Ready to run binaries (*-itk) can be found at:
  https://sourceforge.net/projects/kbskit/files/itk/

To load itk call:
  package require itk 4.0
and to load itk and iwidgets call:
  package require iwidgets 4.1

Install
-------

Copy the library directory as iwidgets4.1 in your tcl library path.
  cp -r library <your-install-path>/iwidgets4.1

Documentation
-------------

Please refer to the original documantation at
  http://incrtcl.sourceforge.net/iwidgets/

License & support
-----------------

This work is under BSD license (see file 'license.terms')

Acknowledgements
----------------

This work is based on the original "iwidgets" work at
  http://incrtcl.sourceforge.net/iwidgets/

Added iwidgets.patch.

























































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
diff -Nupr /home/rene/kbs.sf/sources/iwidgets4.0.2/generic/combobox.itk generic/combobox.itk
--- /home/rene/kbs.sf/sources/iwidgets4.0.2/generic/combobox.itk	2007-05-25 01:06:45.000000000 +0200
+++ generic/combobox.itk	2012-05-21 10:35:15.933262250 +0200
@@ -521,7 +521,8 @@ itcl::body iwidgets::Combobox::insert {c
 	    } else {
 		if {$itk_option(-state) == "normal"} {
 		    eval iwidgets::Entryfield::insert $index $args
-		    [itcl::code $this _lookup ""]
+		    #RZ [itcl::code $this _lookup ""]
+		    eval [itcl::code $this _lookup ""]
 		}
 	    }
 	}
diff -Nupr /home/rene/kbs.sf/sources/iwidgets4.0.2/generic/labeledframe.itk generic/labeledframe.itk
--- /home/rene/kbs.sf/sources/iwidgets4.0.2/generic/labeledframe.itk	2001-08-15 20:32:51.000000000 +0200
+++ generic/labeledframe.itk	2012-05-21 12:23:03.849527914 +0200
@@ -289,6 +289,7 @@ itcl::configbody iwidgets::Labeledframe:
 #     {"-relx" "-rely" <rowconfigure|columnconfigure> <row/column number>}
 # -----------------------------------------------------------------------------
 itcl::body iwidgets::Labeledframe::_initTable {} {
+  if {![catch {set _LAYOUT_TABLE(nw-relx)}]} return ;#RZ
   array set _LAYOUT_TABLE {
     nw-relx 0.0  nw-rely 0.0  nw-wrap 0 nw-conf rowconfigure    nw-num 0
     n-relx  0.5  n-rely  0.0  n-wrap  0 n-conf  rowconfigure    n-num  0
@@ -313,7 +314,7 @@ itcl::body iwidgets::Labeledframe::_init
   #
   # NOTE: Be careful to use the "body" command, or the proc will get lost!
   #
-  itcl::body ::iwidgets::Labeledframe::_initTable {} {}
+  #RZ itcl::body ::iwidgets::Labeledframe::_initTable {} {}
 }
 
 # -----------------------------------------------------------------------------
diff -Nupr /home/rene/kbs.sf/sources/iwidgets4.0.2/generic/menubar.itk generic/menubar.itk
--- /home/rene/kbs.sf/sources/iwidgets4.0.2/generic/menubar.itk	2001-08-15 20:33:13.000000000 +0200
+++ generic/menubar.itk	2012-05-21 12:27:32.039459872 +0200
@@ -160,6 +160,7 @@ itcl::class iwidgets::Menubar {
 
 	variable _menuOption          ;# The -menu option
 	variable _helpString          ;# The -helpstr optio
+	variable _fixed 0 ;#RZ bug fix
     }
 }
 
@@ -198,7 +199,7 @@ itcl::body iwidgets::Menubar::constructo
     set _pathMap(.) $itk_component(menubar)
 
     eval itk_initialize $args
-
+    set _fixed 1 ;#RZ
     #
     # HACK HACK HACK
     # Tk expects some variables to be defined and due to some
@@ -357,7 +358,8 @@ itcl::configbody iwidgets::Menubar::menu
 
 	# IF one exists already, delete the old one and create
 	# a new one
-	if { ! [catch {_parsePath .0}] } {
+	#RZ if { ! [catch {_parsePath .0}] } 
+	if { $_fixed && ! [catch {_parsePath .0}] } {
 	    delete .0 .last
 	} 
 
@@ -2071,9 +2073,7 @@ itcl::body iwidgets::Menubar::_parsePath
 
     set concatPath ""
     foreach seg $segments {
-
 	set concatPath [_getSymbolicPath $concatPath $seg]
-
 	if { [catch {set _pathMap($concatPath)} ] } {
 	    error "bad path: \"$path\" does not exist. \"$seg\" not valid"
 	}
diff -Nupr /home/rene/kbs.sf/sources/iwidgets4.0.2/generic/scrolledhtml.itk generic/scrolledhtml.itk
--- /home/rene/kbs.sf/sources/iwidgets4.0.2/generic/scrolledhtml.itk	2004-12-02 18:49:18.000000000 +0100
+++ generic/scrolledhtml.itk	2012-05-21 10:46:55.428543431 +0200
@@ -139,7 +139,7 @@ itcl::class iwidgets::Scrolledhtml {
   itk_option define -alink alink ALink red
   itk_option define -linkhighlight alink ALink red
   itk_option define -unknownimage unknownimage File {}
-  itk_option define -textbackground textBackground Background {}
+  itk_option define -textbackground textBackground Background {#ffffff};#RZ
   itk_option define -update update Update 1
   itk_option define -debug debug Debug 0
 
@@ -352,7 +352,8 @@ itcl::body iwidgets::Scrolledhtml::destr
     foreach x $_images {
       ::image delete $x
     }
-    if {$_unknownimg != $_defUnknownImg} {
+    #RZ if {$_unknownimg != $_defUnknownImg}
+    if {$_unknownimg != "" && $_unknownimg != $_defUnknownImg} {
       ::image delete $_unknownimg
     }
 }
diff -Nupr /home/rene/kbs.sf/sources/iwidgets4.0.2/generic/toolbar.itk generic/toolbar.itk
--- /home/rene/kbs.sf/sources/iwidgets4.0.2/generic/toolbar.itk	2001-08-17 21:05:54.000000000 +0200
+++ generic/toolbar.itk	2012-05-21 10:59:31.804539052 +0200
@@ -684,7 +684,8 @@ itcl::body iwidgets::Toolbar::_addWidget
     foreach optionSet [$itk_component($name) configure] {
 	set option [lindex $optionSet 0]
 	if { [lsearch $_optionList $option] != -1 } {
-	    itk_option add $name.$option
+	    #RZ itk_option add $name.$option
+	    itk_option add $name.[string range $option 1 end]
 	}
     }
     

Added library/buttonbox.itk.























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
#
# Buttonbox
# ----------------------------------------------------------------------
# Manages a framed area with Motif style buttons.  The button box can 
# be configured either horizontally or vertically.  
#
# ----------------------------------------------------------------------
#  AUTHOR: Mark L. Ulferts              EMAIL: mulferts@austin.dsccc.com
#          Bret A. Schuhmacher          EMAIL: bas@wn.com
#
#  @(#) $Id: buttonbox.itk,v 1.3 2001/08/15 18:30:53 smithc Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1995 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Buttonbox {
    keep -background -cursor -foreground
}

# ------------------------------------------------------------------
#                            BUTTONBOX
# ------------------------------------------------------------------
itcl::class iwidgets::Buttonbox {
    inherit itk::Widget

    constructor {args} {}
    destructor {}

    itk_option define -pady padY Pad 5
    itk_option define -padx padX Pad 5
    itk_option define -orient orient Orient "horizontal"
    itk_option define -foreground foreground Foreground black
    
    public method index {args}
    public method add {args}
    public method insert {args}
    public method delete {args}
    public method default {args}
    public method hide {args}
    public method show {args}
    public method invoke {args}
    public method buttonconfigure {args}
    public method buttoncget {index option}

    private method _positionButtons {}
    private method _setBoxSize {{when later}}
    private method _getMaxWidth {}
    private method _getMaxHeight {}

    private variable _resizeFlag {}         ;# Flag for resize needed.
    private variable _buttonList {}         ;# List of all buttons in box.
    private variable _displayList {}        ;# List of displayed buttons.
    private variable _unique 0              ;# Counter for button widget ids.
}

namespace eval iwidgets::Buttonbox {
    #
    # Set up some class level bindings for map and configure events.
    #
    bind bbox-map <Map> [itcl::code %W _setBoxSize]
    bind bbox-config <Configure> [itcl::code %W _positionButtons]
}

#
# Provide a lowercased access method for the Buttonbox class.
# 
proc ::iwidgets::buttonbox {pathName args} {
    uplevel ::iwidgets::Buttonbox $pathName $args
}
    
# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::constructor {args} {
    # 
    # Add Configure bindings for geometry management.  
    #
    bindtags $itk_component(hull) \
	    [linsert [bindtags $itk_component(hull)] 0 bbox-map]
    bindtags $itk_component(hull) \
	    [linsert [bindtags $itk_component(hull)] 1 bbox-config]
    
    pack propagate $itk_component(hull) no
    
    #
    # Initialize the widget based on the command line options.
    #
    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                           DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::destructor {} {
    if {$_resizeFlag != ""} {after cancel $_resizeFlag}
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -pady
#
# Pad the y space between the button box frame and the hull.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Buttonbox::pady {
    _setBoxSize
}

# ------------------------------------------------------------------
# OPTION: -padx
#
# Pad the x space between the button box frame and the hull.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Buttonbox::padx {
    _setBoxSize
}

# ------------------------------------------------------------------
# OPTION: -orient
#
# Position buttons either horizontally or vertically.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Buttonbox::orient {
    switch $itk_option(-orient) {
	"horizontal" -
	"vertical" {
	    _setBoxSize
	}
	
	default {
	    error "bad orientation option \"$itk_option(-orient)\",\
		    should be either horizontal or vertical"
	}
    }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: index index
#
# Searches the buttons in the box for the one with the requested tag,
# numerical index, keyword "end" or "default".  Returns the button's 
# tag if found, otherwise error.
# ------------------------------------------------------------------    
itcl::body iwidgets::Buttonbox::index {index} {
    if {[llength $_buttonList] > 0} {
	if {[regexp {(^[0-9]+$)} $index]} {
	    if {$index < [llength $_buttonList]} {
		return $index
	    } else {
		error "Buttonbox index \"$index\" is out of range"
	    }
	    
	} elseif {$index == "end"} {
	    return [expr {[llength $_buttonList] - 1}]
	    
	} elseif {$index == "default"} {
	    foreach knownButton $_buttonList {
		if {[$itk_component($knownButton) cget -defaultring]} {
		    return [lsearch -exact $_buttonList $knownButton]
		}
	    }
	    
	    error "Buttonbox \"$itk_component(hull)\" has no default"
	    
	} else {
	    if {[set idx [lsearch $_buttonList $index]] != -1} {
		return $idx
	    }
	    
	    error "bad Buttonbox index \"$index\": must be number, end,\
		    default, or pattern"
	}
	
    } else {
	error "Buttonbox \"$itk_component(hull)\" has no buttons"
    }
}

# ------------------------------------------------------------------
# METHOD: add tag ?option value option value ...?
#
# Add the specified button to the button box.  All PushButton options
# are allowed.  New buttons are added to the list of buttons and the 
# list of displayed buttons.  The PushButton path name is returned.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::add {tag args} {
    itk_component add $tag {
	iwidgets::Pushbutton $itk_component(hull).[incr _unique]
    } {
	usual
	rename -highlightbackground -background background Background
    }
    
    if {$args != ""} {
	uplevel $itk_component($tag) configure $args
    }
    
    lappend _buttonList $tag
    lappend _displayList $tag
    
    _setBoxSize
}

# ------------------------------------------------------------------
# METHOD: insert index tag ?option value option value ...?
#
# Insert the specified button in the button box just before the one 
# given by index.  All PushButton options are allowed.  New buttons 
# are added to the list of buttons and the list of displayed buttons.
# The PushButton path name is returned.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::insert {index tag args} {
    itk_component add $tag {
	iwidgets::Pushbutton $itk_component(hull).[incr _unique]
    } {
	usual
	rename -highlightbackground -background background Background
    }
    
    if {$args != ""} {
	uplevel $itk_component($tag) configure $args
    }
    
    set index [index $index]
    set _buttonList [linsert $_buttonList $index $tag]
    set _displayList [linsert $_displayList $index $tag]
    
    _setBoxSize
}

# ------------------------------------------------------------------
# METHOD: delete index
#
# Delete the specified button from the button box.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::delete {index} {
    set index [index $index]
    set tag [lindex $_buttonList $index]
    
    destroy $itk_component($tag)
    
    set _buttonList [lreplace $_buttonList $index $index]
    
    if {[set dind [lsearch $_displayList $tag]] != -1} {
	set _displayList [lreplace $_displayList $dind $dind]
    }
    
    _setBoxSize
    update idletasks
}

# ------------------------------------------------------------------
# METHOD: default index
#
# Sets the default to the push button given by index.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::default {index} {
    set index [index $index]
    
    set defbtn [lindex $_buttonList $index]
    
    foreach knownButton $_displayList {
	if {$knownButton == $defbtn} {
	    $itk_component($knownButton) configure -defaultring yes
	} else {
	    $itk_component($knownButton) configure -defaultring no
	}
    }
}

# ------------------------------------------------------------------
# METHOD: hide index
#
# Hide the push button given by index.  This doesn't remove the button 
# permanently from the display list, just inhibits its display.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::hide {index} {
    set index [index $index]
    set tag [lindex $_buttonList $index]
    
    if {[set dind [lsearch $_displayList $tag]] != -1} {
	place forget $itk_component($tag)
	set _displayList [lreplace $_displayList $dind $dind] 
	
	_setBoxSize
    }
}

# ------------------------------------------------------------------
# METHOD: show index
#
# Displays a previously hidden push button given by index.  Check if 
# the button is already in the display list.  If not then add it back 
# at it's original location and redisplay.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::show {index} {
    set index [index $index]
    set tag [lindex $_buttonList $index]
    
    if {[lsearch $_displayList $tag] == -1} {
	set _displayList [linsert $_displayList $index $tag]
	
	_setBoxSize
    }
}

# ------------------------------------------------------------------
# METHOD: invoke ?index?
#
# Invoke the command associated with a push button.  If no arguments
# are given then the default button is invoked, otherwise the argument
# is expected to be a button index.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::invoke {args} {
    if {[llength $args] == 0} {
	$itk_component([lindex $_buttonList [index default]]) invoke
	
    } else {
	$itk_component([lindex $_buttonList [index [lindex $args 0]]]) \
		invoke
    }
}

# ------------------------------------------------------------------
# METHOD: buttonconfigure index ?option? ?value option value ...?
#
# Configure a push button given by index.  This method allows 
# configuration of pushbuttons from the Buttonbox level.  The options
# may have any of the values accepted by the add method.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::buttonconfigure {index args} {
    set tag [lindex $_buttonList [index $index]]
    
    set retstr [uplevel $itk_component($tag) configure $args]
    
    _setBoxSize
    
    return $retstr
}

# ------------------------------------------------------------------
# METHOD: buttonccget index option
#
# Return value of option for push button given by index.  Option may
# have any of the values accepted by the add method.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::buttoncget {index option} {
    set tag [lindex $_buttonList [index $index]]
    
    set retstr [uplevel $itk_component($tag) cget [list $option]]
    
    return $retstr
}

# -----------------------------------------------------------------
# PRIVATE METHOD: _getMaxWidth
#
# Returns the required width of the largest button.
# -----------------------------------------------------------------
itcl::body iwidgets::Buttonbox::_getMaxWidth {} {
    set max 0
    
    foreach tag $_displayList {
	set w [winfo reqwidth $itk_component($tag)]
	
	if {$w > $max} {
	    set max $w
	}
    }
    
    return $max
}

# -----------------------------------------------------------------
# PRIVATE METHOD: _getMaxHeight
#
# Returns the required height of the largest button.
# -----------------------------------------------------------------
itcl::body iwidgets::Buttonbox::_getMaxHeight {} {
    set max 0
    
    foreach tag $_displayList {
	set h [winfo reqheight $itk_component($tag)]
	
	if {$h > $max} {
	    set max $h
	}
    }
    
    return $max
}

# ------------------------------------------------------------------
# METHOD: _setBoxSize ?when?
#
# Sets the proper size of the frame surrounding all the buttons.
# If "when" is "now", the change is applied immediately.  If it is 
# "later" or it is not specified, then the change is applied later, 
# when the application is idle.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::_setBoxSize {{when later}} {
    if {[winfo ismapped $itk_component(hull)]} {
	if {$when == "later"} {
	    if {$_resizeFlag == ""} {
		set _resizeFlag [after idle [itcl::code $this _setBoxSize now]]
	    }
	    return
	} elseif {$when != "now"} {
	    error "bad option \"$when\": should be now or later"
	}

	set _resizeFlag ""

	set numBtns [llength $_displayList]
	
	if {$itk_option(-orient) == "horizontal"} {
	    set minw [expr {$numBtns * [_getMaxWidth] \
		    + ($numBtns+1) * $itk_option(-padx)}]
	    set minh [expr {[_getMaxHeight] + 2 * $itk_option(-pady)}]
	    
	} else {
	    set minw [expr {[_getMaxWidth] + 2 * $itk_option(-padx)}]
	    set minh [expr {$numBtns * [_getMaxHeight] \
		    + ($numBtns+1) * $itk_option(-pady)}]
	}
	
	#
	# Remove the configure event bindings on the hull while we adjust the
	# width/height and re-position the buttons.  Once we're through, we'll
	# update and reinstall them.  This prevents double calls to position
	# the buttons.
	#
	set tags [bindtags $itk_component(hull)]
	if {[set i [lsearch $tags bbox-config]] != -1} {
	    set tags [lreplace $tags $i $i]
	    bindtags $itk_component(hull) $tags
	}
	
	component hull configure -width $minw -height $minh
	
	update idletasks
	    
	_positionButtons
	
	bindtags $itk_component(hull) [linsert $tags 0 bbox-config]
    }
}
    
# ------------------------------------------------------------------
# METHOD: _positionButtons
# 
# This method is responsible setting the width/height of all the 
# displayed buttons to the same value and for placing all the buttons
# in equidistant locations.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::_positionButtons {} {
    set bf $itk_component(hull)
    set numBtns [llength $_displayList]
    
    # 
    # First, determine the common width and height for all the 
    # displayed buttons.
    #
    if {$numBtns > 0} {
	set bfWidth [winfo width $itk_component(hull)]
	set bfHeight [winfo height $itk_component(hull)]
	
	if {$bfWidth >= [winfo reqwidth $itk_component(hull)]} {
	    set _btnWidth [_getMaxWidth] 
	    
	} else {
	    if {$itk_option(-orient) == "horizontal"} {
		set _btnWidth [expr {$bfWidth / $numBtns}]
	    } else {
		set _btnWidth $bfWidth
	    }
	}	    
	
	if {$bfHeight >= [winfo reqheight $itk_component(hull)]} {
	    set _btnHeight [_getMaxHeight]
	    
	} else {
	    if {$itk_option(-orient) == "vertical"} {
		set _btnHeight [expr {$bfHeight / $numBtns}]
	    } else {
		set _btnHeight $bfHeight
	    }
	}	    
    }
    
    #
    # Place the buttons at the proper locations.
    #
    if {$numBtns > 0} {
	if {$itk_option(-orient) == "horizontal"} {
	    set leftover [expr {[winfo width $bf] \
		    - 2 * $itk_option(-padx) - $_btnWidth * $numBtns}]
	    
	    if {$numBtns > 0} {
		set offset [expr {$leftover / ($numBtns + 1)}]
	    } else {
		set offset 0
	    }
	    if {$offset < 0} {set offset 0}
	    
	    set xDist [expr {$itk_option(-padx) + $offset}]
	    set incrAmount [expr {$_btnWidth + $offset}]
	    
	    foreach button $_displayList {
		place $itk_component($button) -anchor w \
			-x $xDist -rely .5 -y 0 -relx 0 \
			-width $_btnWidth -height $_btnHeight
		
		set xDist [expr {$xDist + $incrAmount}]
	    }
	    
	} else {
	    set leftover [expr {[winfo height $bf] \
		    - 2 * $itk_option(-pady) - $_btnHeight * $numBtns}]
	    
	    if {$numBtns > 0} {
		set offset [expr {$leftover / ($numBtns + 1)}]
	    } else {
		set offset 0
	    }
	    if {$offset < 0} {set offset 0}
	    
	    set yDist [expr {$itk_option(-pady) + $offset}]
	    set incrAmount [expr {$_btnHeight + $offset}]
	    
	    foreach button $_displayList {
		place $itk_component($button) -anchor n \
			-y $yDist -relx .5 -x 0 -rely 0 \
			-width $_btnWidth -height $_btnHeight
		
		set yDist [expr {$yDist + $incrAmount}]
	    }
	}
    }
}


Added library/calendar.itk.































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
#
# Calendar
# ----------------------------------------------------------------------
# Implements a calendar widget for the selection of a date.  It displays
# a single month at a time.  Buttons exist on the top to change the 
# month in effect turning th pages of a calendar.  As a page is turned, 
# the dates for the month are modified.  Selection of a date visually 
# marks that date.  The selected value can be monitored via the 
# -command option or just retrieved using the get method.  Methods also
# exist to select a date and show a particular month.  The option set
# allows the calendars appearance to take on many forms.
# ----------------------------------------------------------------------
# AUTHOR:  Mark L. Ulferts             E-mail: mulferts@austin.dsccc.com
#            
# ACKNOWLEDGEMENTS: Michael McLennan   E-mail: mmclennan@lucent.com
#
# This code is an [incr Tk] port of the calendar code shown in Michael 
# J. McLennan's book "Effective Tcl" from Addison Wesley.  Small 
# modificiations were made to the logic here and there to make it a 
# mega-widget and the command and option interface was expanded to make 
# it even more configurable, but the underlying logic is the same.
#
# @(#) $Id: calendar.itk,v 1.9 2007/05/24 22:41:02 hobbs Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1997 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Calendar {
    keep -background -cursor 
}

# ------------------------------------------------------------------
#                            CALENDAR
# ------------------------------------------------------------------
itcl::class iwidgets::Calendar {
    inherit itk::Widget
    
    constructor {args} {}

    itk_option define -days days Days {Su Mo Tu We Th Fr Sa}
    itk_option define -command command Command {}
    itk_option define -forwardimage forwardImage Image {}
    itk_option define -backwardimage backwardImage Image {}
    itk_option define -weekdaybackground weekdayBackground Background \#d9d9d9
    itk_option define -weekendbackground weekendBackground Background \#d9d9d9
    itk_option define -outline outline Outline \#d9d9d9
    itk_option define -buttonforeground buttonForeground Foreground blue
    itk_option define -foreground foreground Foreground black
    itk_option define -selectcolor selectColor Foreground red
    itk_option define -selectthickness selectThickness SelectThickness 3
    itk_option define -titlefont titleFont Font \
	-*-helvetica-bold-r-normal--*-140-*
    itk_option define -dayfont dayFont Font \
	-*-helvetica-medium-r-normal--*-120-*
    itk_option define -datefont dateFont Font \
	-*-helvetica-medium-r-normal--*-120-*
    itk_option define -currentdatefont currentDateFont Font \
	-*-helvetica-bold-r-normal--*-120-*
    itk_option define -startday startDay Day sunday
    itk_option define -int int DateFormat no

    public method get {{format "-string"}} ;# Returns the selected date
    public method select {{date_ "now"}}   ;# Selects date, moving select ring
    public method show {{date_ "now"}}     ;# Displays a specific date

    protected method _drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_} 

    private method _change {delta_}
    private method _configureHandler {}
    private method _redraw {}
    private method _days {{wmax {}}}
    private method _layout {time_}
    private method _select {date_}
    private method _selectEvent {date_}
    private method _adjustday {day_}
    private method _percentSubst {pattern_ string_ subst_}

    private variable _time {}
    private variable _selected {}
    private variable _initialized 0
    private variable _offset 0
    private variable _format {}
}

#
# Provide a lowercased access method for the Calendar class.
# 
proc ::iwidgets::calendar {pathName args} {
    uplevel ::iwidgets::Calendar $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *Calendar.width 200 widgetDefault
option add *Calendar.height 165 widgetDefault

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::constructor {args} {
    #
    # Create the canvas which displays each page of the calendar.
    #
    itk_component add page {
	canvas $itk_interior.page
    } {
	keep -background -cursor -width -height
    }
    pack $itk_component(page) -expand yes -fill both
    
    #
    # Create the forward and backward buttons.  Rather than pack
    # them directly in the hull, we'll waittill later and make
    # them canvas window items.
    #
    itk_component add backward {
	button $itk_component(page).backward \
		-command [itcl::code $this _change -1]
    } {
	keep -background -cursor 
    }

    itk_component add forward {
	button $itk_component(page).forward \
		-command [itcl::code $this _change +1]
    } {
	keep -background -cursor 
    }

    #
    # Set the initial time to now.
    #
    set _time [clock seconds]

    # 
    # Bind to the configure event which will be used to redraw
    # the calendar and display the month.
    #
    bind $itk_component(page) <Configure> [itcl::code $this _configureHandler]
    
    #
    # Evaluate the option arguments.
    #
    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -int
#
# Added by Mark Alston 2001/10/21
#
# Allows for the use of dates in "international" format: YYYY-MM-DD.
# It must be a boolean value.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::int { 
    switch $itk_option(-int) {
	1 - yes - true - on {
	  set itk_option(-int) yes
	}
	0 - no - false - off {
	  set itk_option(-int) no
	}
	default {
	    error "bad int option \"$itk_option(-int)\": should be boolean"
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -command
#
# Sets the selection command for the calendar.  When the user 
# selects a date on the calendar, the date is substituted in
# place of "%d" in this command, and the command is executed.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::command {}

# ------------------------------------------------------------------
# OPTION: -days
#
# The days option takes a list of values to set the text used to display the 
# days of the week header above the dates.  The default value is 
# {Su Mo Tu We Th Fr Sa}.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::days {
    if {$_initialized} {
	if {[$itk_component(page) find withtag days] != {}} {
	    $itk_component(page) delete days
	    _days
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -backwardimage
#
# Specifies a image to be displayed on the backwards calendar 
# button.  If none is specified, a default is provided.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::backwardimage {

    #
    # If no image is given, then we'll use the default image.
    #
    if {$itk_option(-backwardimage) == {}} {

	#
	# If the default image hasn't yet been created, then we
	# need to create it.
	#
	if {[lsearch [image names] $this-backward] == -1} {
	    image create bitmap $this-backward \
		    -foreground $itk_option(-buttonforeground) -data {
		#define back_width 16
		#define back_height 16
		static unsigned char back_bits[] = {
		    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x30, 
		    0xe0, 0x38, 0xf0, 0x3c, 0xf8, 0x3e, 0xfc, 0x3f, 
		    0xfc, 0x3f, 0xf8, 0x3e, 0xf0, 0x3c, 0xe0, 0x38,
		    0xc0, 0x30, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
		}
	}

	#
	# Configure the button to use the default image.
	#
	$itk_component(backward) configure -image $this-backward
	
    #
    # Else, an image has been specified.  First, we'll need to make sure
    # the image really exists before configuring the button to use it.  
    # If it doesn't generate an error.
    #
    } else {
	if {[lsearch [image names] $itk_option(-backwardimage)] != -1} {
	    $itk_component(backward) configure \
		    -image $itk_option(-backwardimage)
	} else {
	    error "bad image name \"$itk_option(-backwardimage)\":\
		    image does not exist"
	}

	#
	# If we previously created a default image, we'll just remove it.
	#
	if {[lsearch [image names] $this-backward] != -1} {
	    image delete $this-backward
	}
    }
}


# ------------------------------------------------------------------
# OPTION: -forwardimage
#
# Specifies a image to be displayed on the forwards calendar 
# button.  If none is specified, a default is provided.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::forwardimage {

    #
    # If no image is given, then we'll use the default image.
    #
    if {$itk_option(-forwardimage) == {}} {

	#
	# If the default image hasn't yet been created, then we
	# need to create it.
	#
	if {[lsearch [image names] $this-forward] == -1} {
	    image create bitmap $this-forward \
		    -foreground $itk_option(-buttonforeground) -data {
		#define fwd_width 16
		#define fwd_height 16
		static unsigned char fwd_bits[] = {
		    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x03, 
		    0x1c, 0x07, 0x3c, 0x0f, 0x7c, 0x1f, 0xfc, 0x3f, 
		    0xfc, 0x3f, 0x7c, 0x1f, 0x3c, 0x0f, 0x1c, 0x07,
		    0x0c, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
		}
	}

	#
	# Configure the button to use the default image.
	#
	$itk_component(forward) configure -image $this-forward
	
    #
    # Else, an image has been specified.  First, we'll need to make sure
    # the image really exists before configuring the button to use it.  
    # If it doesn't generate an error.
    #
    } else {
	if {[lsearch [image names] $itk_option(-forwardimage)] != -1} {
	    $itk_component(forward) configure \
		    -image $itk_option(-forwardimage)
	} else {
	    error "bad image name \"$itk_option(-forwardimage)\":\
		    image does not exist"
	}

	#
	# If we previously created a default image, we'll just remove it.
	#
	if {[lsearch [image names] $this-forward] != -1} {
	    image delete $this-forward
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -weekdaybackground
#
# Specifies the background for the weekdays which allows it to
# be visually distinguished from the weekend.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::weekdaybackground {
    if {$_initialized} {
	$itk_component(page) itemconfigure weekday \
		-fill $itk_option(-weekdaybackground)
    }
}

# ------------------------------------------------------------------
# OPTION: -weekendbackground
#
# Specifies the background for the weekdays which allows it to
# be visually distinguished from the weekdays.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::weekendbackground {
    if {$_initialized} {
	$itk_component(page) itemconfigure weekend \
		-fill $itk_option(-weekendbackground)
    }
}

# ------------------------------------------------------------------
# OPTION: -foreground
#
# Specifies the foreground color for the textual items, buttons,
# and divider on the calendar.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::foreground {
    if {$_initialized} {
	$itk_component(page) itemconfigure text \
		-fill $itk_option(-foreground)
	$itk_component(page) itemconfigure line \
		-fill $itk_option(-foreground)
    }
}

# ------------------------------------------------------------------
# OPTION: -outline
#
# Specifies the outline color used to surround the date text.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::outline {
    if {$_initialized} {
	$itk_component(page) itemconfigure square \
		-outline $itk_option(-outline)
    }
}

# ------------------------------------------------------------------
# OPTION: -buttonforeground
#
# Specifies the foreground color of the forward and backward buttons.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::buttonforeground {
    if {$_initialized} {
	if {$itk_option(-forwardimage) == {}} {
	    if {[lsearch [image names] $this-forward] != -1} {
		$this-forward configure \
		    -foreground $itk_option(-buttonforeground)
	    }
	} else {
	    $itk_component(forward) configure \
		    -foreground $itk_option(-buttonforeground)
	}
	
	if {$itk_option(-backwardimage) == {}} {
	    if {[lsearch [image names] $this-backward] != -1} {
		$this-backward configure \
		    -foreground $itk_option(-buttonforeground)
	    }
	} else {
	    $itk_component(-backward) configure \
		    -foreground $itk_option(-buttonforeground)
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -selectcolor
#
# Specifies the color of the ring displayed that distinguishes the 
# currently selected date.  
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::selectcolor {
    if {$_initialized} {
	$itk_component(page) itemconfigure $_selected-sensor \
		-outline $itk_option(-selectcolor) 
    }
}

# ------------------------------------------------------------------
# OPTION: -selectthickness
#
# Specifies the thickness of the ring displayed that distinguishes 
# the currently selected date.  
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::selectthickness {
    if {$_initialized} {
	$itk_component(page) itemconfigure $_selected-sensor \
		-width $itk_option(-selectthickness) 
    }
}

# ------------------------------------------------------------------
# OPTION: -titlefont
#
# Specifies the font used for the title text that consists of the 
# month and year.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::titlefont {
    if {$_initialized} {
	$itk_component(page) itemconfigure title \
		-font $itk_option(-titlefont)
    }
}

# ------------------------------------------------------------------
# OPTION: -datefont
#
# Specifies the font used for the date text that consists of the 
# day of the month.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::datefont {
    if {$_initialized} {
	$itk_component(page) itemconfigure date \
		-font $itk_option(-datefont)
    }
}

# ------------------------------------------------------------------
# OPTION: -currentdatefont
#
# Specifies the font used for the current date text.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::currentdatefont {
    if {$_initialized} {
	$itk_component(page) itemconfigure now \
		-font $itk_option(-currentdatefont)
    }
}

# ------------------------------------------------------------------
# OPTION: -dayfont
#
# Specifies the font used for the day of the week text.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::dayfont {
    if {$_initialized} {
	$itk_component(page) itemconfigure days \
		-font $itk_option(-dayfont)
    }
}

# ------------------------------------------------------------------
# OPTION: -startday
#
# Specifies the starting day for the week.  The value must be a day of the
# week: sunday, monday, tuesday, wednesday, thursday, friday, or
# saturday.  The default is sunday.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::startday {
    set day [string tolower $itk_option(-startday)]

    switch $day {
	sunday {set _offset 0}
	monday {set _offset 1}
	tuesday {set _offset 2}
	wednesday {set _offset 3}
	thursday {set _offset 4}
	friday {set _offset 5}
	saturday {set _offset 6}
	default {
	    error "bad startday option \"$itk_option(-startday)\":\
                   should be sunday, monday, tuesday, wednesday,\
                   thursday, friday, or saturday"
	}
    }

    if {$_initialized} {
	$itk_component(page) delete all-page
	_redraw
    }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# PUBLIC METHOD: get ?format?
#
# Returns the currently selected date in one of two formats, string 
# or as an integer clock value using the -string and -clicks
# options respectively.  The default is by string.  Reference the 
# clock command for more information on obtaining dates and their 
# formats.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::get {{format "-string"}} {
    switch -- $format {
	"-string" {
	    return $_selected
	}
	"-clicks" {
	    return [clock scan $_selected]
	}
	default {
	    error "bad format option \"$format\":\
                   should be -string or -clicks"
	}
    }
}

# ------------------------------------------------------------------
# PUBLIC METHOD: select date_
#
# Changes the currently selected date to the value specified.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::select {{date_ "now"}} {
    if {$date_ == "now"} {
	set time [clock seconds]
    } else {
	if {[catch {clock format $date_}] == 0} {
	    set time $date_
	} elseif {[catch {set time [clock scan $date_]}] != 0} {
	    error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now"
	}
    }
    switch $itk_option(-int) {
	yes { set _format "%Y-%m-%d" }
	no { set _format "%m/%d/%Y" }
    }
    _select [clock format $time -format "$_format"]
}

# ------------------------------------------------------------------
# PUBLIC METHOD: show date_
#
# Changes the currently display month to be that of the specified 
# date.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::show {{date_ "now"}} {
    if {$date_ == "now"} {
	set _time [clock seconds]
    } else {
	if {[catch {clock format $date_}] == 0} {
	    set _time $date_
	} elseif {[catch {set _time [clock scan $date_]}] != 0} {
	    error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now"
	}
    }

    $itk_component(page) delete all-page
    _redraw
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _drawtext canvas_ day_ date_ now_
#                             x0_ y0_ x1_ y1_
#
# Draws the text in the date square.  The method is protected such that
# it can be overridden in derived classes that may wish to add their
# own unique text.  The method receives the day to draw along with
# the coordinates of the square.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_} {
    set item [$canvas_ create text \
		  [expr {(($x1_ - $x0_) / 2) + $x0_}] \
		  [expr {(($y1_ -$y0_) / 2) + $y0_ + 1}] \
		  -anchor center -text "$day_" \
		  -fill $itk_option(-foreground)]

    if {$date_ == $now_} {
	$canvas_ itemconfigure $item \
	    -font $itk_option(-currentdatefont) \
	    -tags [list all-page date $date_-date text now]
    } else {
	$canvas_ itemconfigure $item \
	    -font $itk_option(-datefont) \
	    -tags [list all-page date $date_-date text]
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _configureHandler
#
# Processes a configure event received on the canvas.  The method
# deletes all the current canvas items and forces a redraw.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_configureHandler {} {
    set _initialized 1

    $itk_component(page) delete all
    _redraw
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _change delta_
#
# Changes the current month displayed in the calendar, moving
# forward or backward by <delta_> months where <delta_> is +/-
# some number.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_change {delta_} {
    set dir [expr {($delta_ > 0) ? 1 : -1}]
    set month [clock format $_time -format "%m"]
    set month [string trimleft $month 0]
    set year [clock format $_time -format "%Y"]

    for {set i 0} {$i < abs($delta_)} {incr i} {
        incr month $dir
        if {$month < 1} {
            set month 12
            incr year -1
        } elseif {$month > 12} {
            set month 1
            incr year 1
        }
    }
    if {[catch {set _time [clock scan "$month/1/$year"]}]} {
	bell
    } else {
	_redraw 
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _redraw
#
# Redraws the calendar.  This method is invoked whenever the 
# calendar changes size or we need to effect a change such as draw
# it with a new month.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_redraw {} {
    #
    # Set the format based on the option -int
    #
    switch $itk_option(-int) {
	yes { set _format "%Y-%m-%d" }
	no { set _format "%m/%d/%Y" }
    }
    #
    # Remove all the items that typically change per redraw request
    # such as the title and dates.  Also, get the maximum width and
    # height of the page.
    #
    $itk_component(page) delete all-page

    set wmax [winfo width $itk_component(page)]
    set hmax [winfo height $itk_component(page)]

    #
    # If we haven't yet created the forward and backwards buttons,
    # then dot it; otherwise, skip it.
    #
    if {[$itk_component(page) find withtag button] == {}} {
	$itk_component(page) create window 3 3 -anchor nw \
		-window $itk_component(backward) -tags button
	$itk_component(page) create window [expr {$wmax-3}] 3 -anchor ne \
		-window $itk_component(forward) -tags button
    }

    #
    # Create the title centered between the buttons.
    #
    foreach {x0 y0 x1 y1} [$itk_component(page) bbox button] {
	set x [expr {(($x1-$x0)/2)+$x0}]
	set y [expr {(($y1-$y0)/2)+$y0}]
    }

    set title [clock format $_time -format "%B %Y"]
    $itk_component(page) create text $x $y -anchor center \
        -text $title -font $itk_option(-titlefont) \
	-fill $itk_option(-foreground) \
	-tags [list title text all-page]

    #
    # Add the days of the week labels if they haven't yet been created.
    #
    if {[$itk_component(page) find withtag days] == {}} {
	_days $wmax
    }

    #
    # Add a line between the calendar header and the dates if needed.
    #
    set bottom [expr {[lindex [$itk_component(page) bbox all] 3] + 3}]

    if {[$itk_component(page) find withtag line] == {}} {
	$itk_component(page) create line 0 $bottom $wmax $bottom \
		-width 2 -tags line
    }

    incr bottom 3

    #
    # Get the layout for the time value and create the date squares.
    # This includes the surrounding date rectangle, the date text,
    # and the sensor.  Bind selection to the sensor.
    #
    set current ""
    set now [clock format [clock seconds] -format "$_format"]

    set layout [_layout $_time]
    set weeks [expr {[lindex $layout end] + 1}]

    foreach {day date kind dcol wrow} $layout {
        set x0 [expr {$dcol*($wmax-7)/7+3}]
        set y0 [expr {$wrow*($hmax-$bottom-4)/$weeks+$bottom}]
        set x1 [expr {($dcol+1)*($wmax-7)/7+3}]
        set y1 [expr {($wrow+1)*($hmax-$bottom-4)/$weeks+$bottom}]

        if {$date == $_selected} {
            set current $date
        }

	#
	# Create the rectangle that surrounds the date and configure
	# its background based on the wheather it is a weekday or
	# a weekend.
	#
	set item [$itk_component(page) create rectangle $x0 $y0 $x1 $y1 \
		-outline $itk_option(-outline)]

	if {$kind == "weekend"} {
	    $itk_component(page) itemconfigure $item \
		    -fill $itk_option(-weekendbackground) \
		    -tags [list all-page square weekend]
	} else {
	    $itk_component(page) itemconfigure $item \
		    -fill $itk_option(-weekdaybackground) \
		    -tags [list all-page square weekday]
	}

	#
	# Create the date text and configure its font based on the 
	# wheather or not it is the current date.
	#
	_drawtext $itk_component(page) $day $date $now $x0 $y0 $x1 $y1

	#
	# Create a sensor area to detect selections.  Bind the 
	# sensor and pass the date to the bind script.
	#
        $itk_component(page) create rectangle $x0 $y0 $x1 $y1 \
            -outline "" -fill "" \
            -tags [list $date-sensor all-sensor all-page]

        $itk_component(page) bind $date-sensor <ButtonPress-1> \
            [itcl::code $this _selectEvent $date]

        $itk_component(page) bind $date-date <ButtonPress-1> \
            [itcl::code $this _selectEvent $date]
    }

    #
    # Highlight the selected date if it is on this page.
    #
    if {$current != ""} {
        $itk_component(page) itemconfigure $current-sensor \
            -outline $itk_option(-selectcolor) \
	    -width $itk_option(-selectthickness)

        $itk_component(page) raise $current-sensor

    } elseif {$_selected == ""} {
        set date [clock format $_time -format "$_format"]
        _select $date
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _days
#
# Used to rewite the days of the week label just below the month 
# title string.  The days are given in the -days option.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_days {{wmax {}}} {
    if {$wmax == {}} {
	set wmax [winfo width $itk_component(page)]
    }

    set col 0
    set bottom [expr {[lindex [$itk_component(page) bbox title buttons] 3] + 7}]

    foreach dayoweek $itk_option(-days) {
	set x0 [expr {$col*($wmax/7)}]
	set x1 [expr {($col+1)*($wmax/7)}]

	$itk_component(page) create text \
	    [expr {(($x1 - $x0) / 2) + $x0}] $bottom \
	    -anchor n -text "$dayoweek" \
	    -fill $itk_option(-foreground) \
	    -font $itk_option(-dayfont) \
	    -tags [list days text]

	incr col
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _layout time_
#
# Used whenever the calendar is redrawn.  Finds the month containing
# a <time_> in seconds, and returns a list for all of the days in 
# that month.  The list looks like this:
#
#    {day1 date1 kind1 c1 r1  day2 date2 kind2 c2 r2  ...}
#
# where dayN is a day number like 1,2,3,..., dateN is the date for
# dayN, kindN is the day type of weekday or weekend, and cN,rN 
# are the column/row indices for the square containing that date.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_layout {time_} {

    switch $itk_option(-int) {
	yes { set _format "%Y-%m-%d" }
	no { set _format "%m/%d/%Y" }
    }

    set month [clock format $time_ -format "%m"]
    set year  [clock format $time_ -format "%Y"]

    if {[info tclversion] >= 8.5} {
	set startOfMonth [clock scan "$year-$month-01" -format %Y-%m-%d]
	set lastday [clock format [clock add $startOfMonth 1 month -1 day] -format %d]
    } else {
	foreach lastday {31 30 29 28} {
	    if {[catch {clock scan "$month/$lastday/$year"}] == 0} {
		break
	    }
	}
    }
    set seconds [clock scan "$month/1/$year"]
    set firstday [_adjustday [clock format $seconds -format %w]]

    set weeks [expr {ceil(double($lastday+$firstday)/7)}]

    set rlist ""
    for {set day 1} {$day <= $lastday} {incr day} {
        set seconds [clock scan "$month/$day/$year"]
        set date [clock format $seconds -format "$_format"]
	set dayoweek [clock format $seconds -format %w]

	if {$dayoweek == 0 || $dayoweek == 6} {
	    set kind "weekend"
	} else {
	    set kind "weekday"
	}

        set daycol [_adjustday $dayoweek]

        set weekrow [expr {($firstday+$day-1)/7}]
        lappend rlist $day $date $kind $daycol $weekrow 
    }
    return $rlist
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _adjustday day_
#
# Modifies the day to be in accordance with the startday option.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_adjustday {day_} {
    set retday [expr {$day_ - $_offset}]

    if {$retday < 0} {
	set retday [expr {$retday + 7}]
    }

    return $retday
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _select date_
#
# Selects the current <date_> on the calendar.  Highlights the date 
# on the calendar, and executes the command associated with the 
# calendar, with the selected date substituted in place of "%d".
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_select {date_} {

    switch $itk_option(-int) {
	yes { set _format "%Y-%m-%d" }
	no { set _format "%m/%d/%Y" }
    }


    set time [clock scan $date_]
    set date [clock format $time -format "$_format"]

    set _selected $date
    set current [clock format $_time -format "%m %Y"]
    set selected [clock format $time -format "%m %Y"]

    if {$current == $selected} {
        $itk_component(page) itemconfigure all-sensor \
            -outline "" -width 1

        $itk_component(page) itemconfigure $date-sensor \
            -outline $itk_option(-selectcolor) \
	    -width $itk_option(-selectthickness)
        $itk_component(page) raise $date-sensor
    } else {
        set _time $time
        _redraw 
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _selectEvent date_
#
# Selects the current <date_> on the calendar.  Highlights the date 
# on the calendar, and executes the command associated with the 
# calendar, with the selected date substituted in place of "%d".
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_selectEvent {date_} {
    _select $date_

    if {[string trim $itk_option(-command)] != ""} {
        set cmd $itk_option(-command)
        set cmd [_percentSubst %d $cmd [get]]
        uplevel #0 $cmd
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _percentSubst pattern_ string_ subst_
#
# This command is a "safe" version of regsub, for substituting
# each occurance of <%pattern_> in <string_> with <subst_>.  The
# usual Tcl "regsub" command does the same thing, but also
# converts characters like "&" and "\0", "\1", etc. that may
# be present in the <subst_> string.
#
# Returns <string_> with <subst_> substituted in place of each
# <%pattern_>.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_percentSubst {pattern_ string_ subst_} {
    if {![string match %* $pattern_]} {
        error "bad pattern \"$pattern_\": should be %something"
    }

    set rval ""
    while {[regexp "(.*)${pattern_}(.*)" $string_ all head tail]} {
        set rval "$subst_$tail$rval"
        set string_ $head
    }
    set rval "$string_$rval"
}

Added library/canvasprintbox.itk.















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
#
# CanvasPrintBox v1.5
# ----------------------------------------------------------------------
# Implements a print box for printing the contents of a canvas widget
# to a printer or a file. It is possible to specify page orientation, the
# number of pages to print the image on and if the output should be
# stretched to fit the page.
# 
# CanvasPrintBox is a "super-widget" that can be used as an
# element in ones own GUIs. It is used to print the contents
# of a canvas (called the source hereafter) to a printer or a
# file. Possible settings include: portrait and landscape orientation
# of the output, stretching the output to fit the page while maintaining
# a proper aspect-ratio and posterizing to enlarge the output to fit on
# multiple pages. A stamp-sized copy of the source will be shown (called
# the stamp hereafter) at all times to reflect the effect of changing
# the settings will have on the output.
#
# ----------------------------------------------------------------------
# AUTHOR: Tako Schotanus               EMAIL: Tako.Schotanus@bouw.tno.nl
# ----------------------------------------------------------------------
#                Copyright (c) 1995  Tako Schotanus
# ======================================================================
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 
# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN 
# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 
# DAMAGE.
#
# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, 
# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
# FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
# ======================================================================

#
# Default resources.
#
option add *Canvasprintbox.filename	"canvas.ps"	widgetDefault
option add *Canvasprintbox.hPageCnt	1		widgetDefault
option add *Canvasprintbox.orient	landscape	widgetDefault
option add *Canvasprintbox.output	printer		widgetDefault
option add *Canvasprintbox.pageSize	A4		widgetDefault
option add *Canvasprintbox.posterize	0		widgetDefault
option add *Canvasprintbox.printCmd	lpr		widgetDefault
option add *Canvasprintbox.printRegion	""		widgetDefault
option add *Canvasprintbox.vPageCnt	1		widgetDefault

#
# Usual options.
#
itk::usual Canvasprintbox {
	keep -background -cursor -textbackground -foreground
}

#<
#
# CanvasPrintBox is a "super-widget" that can be used as an
# element in ones own GUIs. It is used to print the contents
# of a canvas (called the source hereafter) to a printer or a
# file. Possible settings include: portrait and landscape orientation
# of the output, stretching the output to fit the page while maintaining
# a proper aspect-ratio and posterizing to enlarge the output to fit on
# multiple pages. A stamp-sized copy of the source will be shown (called
# the stamp hereafter) at all times to reflect the effect of changing
# the settings will have on the output.
#
#>
itcl::class iwidgets::Canvasprintbox {
	inherit itk::Widget

	#
	# Holds the current state for all check- and radiobuttons.
	#
	itk_option define -filename filename FileName "canvas.ps"
	itk_option define -hpagecnt hPageCnt PageCnt 1
	itk_option define -orient orient Orient "landscape"
	itk_option define -output output Output "printer"
	itk_option define -pagesize pageSize PageSize "A4"
	itk_option define -posterize posterize Posterize 0
	itk_option define -printcmd printCmd PrintCmd ""
	itk_option define -printregion printRegion PrintRegion ""
	itk_option define -stretch stretch Stretch 0
	itk_option define -vpagecnt vPageCnt PageCnt 1
	
	constructor {args} {}
	destructor {}

	# ---------------------------------------------------------------
	# PUBLIC
	#----------------------------------------------------------------
	public {
	  method getoutput {}
	  method print {}
	  method refresh {}
	  method setcanvas {canv}
	  method stop {}
	}

	# ---------------------------------------------------------------
	# PROTECTED
	#----------------------------------------------------------------
	protected {
	  #
	  # Just holds the names of some widgets/objects. "win" is used to
	  # determine if the object is fully constructed and initialized.
	  #
	  variable win ""
	  variable canvw ""
	
	  #
	  # The canvas we want to print. 
	  #
	  variable canvas ""
	
	  #
	  # Boolean indicating if the attribute "orient" is set
	  # to landscape or not.
	  #
	  variable rotate 1
	
	  #
	  # Holds the configure options that were used to create this object.
	  #
	  variable init_opts ""
	
	  #
	  # The following attributes hold a list of lines that are
	  # currently drawn on the "stamp" to show how the page(s) is/are
	  # oriented. The first holds the vertical dividing lines and the
	  # second the horizontal ones.
	  #
	  variable hlines ""
	  variable vlines ""

	  #
	  # Updating is set when the thumbnail is being drawn. Settings
	  # this to 0 while drawing is still busy will terminate the
	  # proces.
	  # Restart_update can be set to 1 when the thumbnail is being
	  # drawn to force a redraw.
	  #
	  variable _reposition ""
	  variable _update_attr_id ""

	  method _calc_poster_size {}
	  method _calc_print_region {}
	  method _calc_print_scale {}
	  method _mapEventHandler {}
	  method _update_attr {{when later}}
	  method _update_canvas {{when later}}

	  common _globVar

	  proc ezPaperInfo {size {attr ""} \
		{orient "portrait"} {window ""}} {}
	}
}

#
# Provide a lowercased access method for the Canvasprintbox class.
# 
proc ::iwidgets::canvasprintbox {args} {
	uplevel ::iwidgets::Canvasprintbox $args
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

#<
# A list of four coordinates specifying which part of the canvas to print.
# An empty list means that the canvas' entire scrollregion should be
# printed. Any change to this attribute will automatically update the "stamp".
# Defaults to an empty list.
#>
itcl::configbody iwidgets::Canvasprintbox::printregion {
	if {$itk_option(-printregion) != ""
	&& [llength $itk_option(-printregion)] != 4} {
		error {bad option "printregion": should contain 4 coordinates}
	}
	_update_canvas
}

#<
# Specifies where the postscript output should go: to the printer
# or to a file. Can take on the values "printer" or "file".
# The corresponding entry-widget will reflect the contents of
# either the printcmd attribute or the filename attribute.
#>
itcl::configbody iwidgets::Canvasprintbox::output {
	switch $itk_option(-output) {
	    file - printer {
		set _globVar($this,output) $itk_option(-output)
	    }
	    default {
		error {bad output option \"$itk_option(-output)\":\
			should be file or printer}
	    }
	}
	_update_attr
}

#<
# The command to execute when printing the postscript output.
# The command will get the postscript directed to its standard
# input. (Only when output is set to "printer")
#>
itcl::configbody iwidgets::Canvasprintbox::printcmd {
	set _globVar($this,printeref) $itk_option(-printcmd)
	_update_attr
}

#<
# The file to write the postscript output to (Only when output
# is set to "file"). If posterizing is turned on and hpagecnt
# and/or vpagecnt is more than 1, x.y is appended to the filename
# where x is the horizontal page number and y the vertical page number.
#>
itcl::configbody iwidgets::Canvasprintbox::filename {
	set _globVar($this,fileef) $itk_option(-filename)
	_update_attr
}

#<
# The pagesize the printer supports. Changes to this attribute
# will be reflected immediately in the "stamp".
#>
itcl::configbody iwidgets::Canvasprintbox::pagesize {
	set opt [string tolower $itk_option(-pagesize)]
	set lst [string tolower [ezPaperInfo types]]
	if {[lsearch $lst $opt] == -1} {
		error "bad option \"pagesize\": should be one of: [ezPaperInfo types]"
	}
	$itk_component(paperom) select "*[string range $opt 1 end]"
	_update_canvas
}

#<
# Determines the orientation of the output to the printer (or file).
# It can take the value "portrait" or "landscape" (default). Changes
# to this attribute will be reflected immediately in the "stamp".
#>
itcl::configbody iwidgets::Canvasprintbox::orient {
	switch $itk_option(-orient) {
	    "portrait" - "landscape" {
		$itk_component(orientom) select $itk_option(-orient)
		_update_canvas

	    }
	    default {
		error "bad orient option \"$itk_option(-orient)\":\
			should be portrait or landscape"
	    }
	}
}

#<
# Determines if the output should be stretched to fill the
# page (as defined by the attribute pagesize) as large as
# possible. The aspect-ratio of the output will be retained
# and the output will never fall outside of the boundaries
# of the page.
#>
itcl::configbody iwidgets::Canvasprintbox::stretch {
	if {$itk_option(-stretch) != 0 && $itk_option(-stretch) != 1} {
		error {bad option "stretch": should be a boolean}
	}
	set _globVar($this,stretchcb) $itk_option(-stretch)
	_update_attr
}

#<
# Indicates if posterizing is turned on or not. Posterizing
# the output means that it is possible to distribute the
# output over more than one page. This way it is possible to
# print a canvas/region which is larger than the specified
# pagesize without stretching. If used in combination with
# stretching it can be used to "blow up" the contents of a
# canvas to as large as size as you want (See attributes:
# hpagecnt end vpagecnt). Any change to this attribute will
# automatically update the "stamp".
#>
itcl::configbody iwidgets::Canvasprintbox::posterize {
	if {$itk_option(-posterize) != "0" && $itk_option(-posterize) != "1"} {
		error "expected boolean but got \"$itk_option(-posterize)\""
	}
	set _globVar($this,postercb) $itk_option(-posterize)
	_update_canvas
}

#<
# Is used in combination with "posterize" to determine over
# how many pages the output should be distributed. This
# attribute specifies how many pages should be used horizontaly.
# Any change to this attribute will automatically update the "stamp".
#>
itcl::configbody iwidgets::Canvasprintbox::hpagecnt {
	set _globVar($this,hpc) $itk_option(-hpagecnt)
	_update_canvas
}

#<
# Is used in combination with "posterize" to determine over
# how many pages the output should be distributed. This
# attribute specifies how many pages should be used verticaly.
# Any change to this attribute will automatically update the "stamp".
#>
itcl::configbody iwidgets::Canvasprintbox::vpagecnt {
	set _globVar($this,vpc) $itk_option(-vpagecnt)
	_update_canvas
}

# ------------------------------------------------------------------
# CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintbox::constructor {args} {
	set _globVar($this,output) printer
	set _globVar($this,printeref) ""
	set _globVar($this,fileef) "canvas.ps"
	set _globVar($this,hpc) 1
	set _globVar($this,vpc) 1
	set _globVar($this,postercb) 0
	set _globVar($this,stretchcb) 0

	itk_component add canvasframe {
		frame $itk_interior.f18 -bd 2
	}

	itk_component add canvas {
		canvas $itk_component(canvasframe).c1 \
			-bd 2 -relief sunken \
			-scrollregion {0c 0c 10c 10c} \
			-width 250
	}
	pack $itk_component(canvas) -expand 1 -fill both

	itk_component add outputom {
		iwidgets::Labeledframe $itk_interior.outputom \
			-labelpos nw \
			-labeltext "Output to"
	}
	set cs [$itk_component(outputom) childsite]

	itk_component add printerrb {
		radiobutton $cs.printerrb \
			-text Printer \
			-variable [itcl::scope _globVar($this,output)] \
			-anchor w \
			-justify left \
			-value printer \
			-command [itcl::code $this _update_attr]
	} { 
		usual
		rename -font -labelfont labelFont Font
	}
	itk_component add printeref {
		iwidgets::entryfield $cs.printeref \
			-labeltext "command:" \
			-state normal \
			-labelpos w \
			-textvariable [itcl::scope _globVar($this,printeref)]
	}

	itk_component add filerb {
		radiobutton $cs.filerb \
			-text File \
			-justify left \
			-anchor w \
			-variable [itcl::scope _globVar($this,output)] \
			-value file \
			-command [itcl::code $this _update_attr]
	} { 
		usual
		rename -font -labelfont labelFont Font
	}
	itk_component add fileef {
		iwidgets::entryfield $cs.fileef \
			-labeltext "filename:" \
			-state disabled \
			-labelpos w \
			-textvariable [itcl::scope _globVar($this,fileef)]
	}

	itk_component add propsframe {
		iwidgets::Labeledframe $itk_interior.propsframe \
			-labelpos nw \
			-labeltext "Properties"
	}
	set cs [$itk_component(propsframe) childsite]

	itk_component add paperom {
		iwidgets::optionmenu $cs.paperom \
			-labelpos w -cyclicon 1 \
			-labeltext "Paper size:" \
			-command [itcl::code $this refresh]
	} { 
		usual
		rename -font -labelfont labelFont Font
	}
	eval $itk_component(paperom) insert end [ezPaperInfo types]
	$itk_component(paperom) select A4

	itk_component add orientom {
		iwidgets::radiobox $itk_interior.orientom \
			-labeltext "Orientation" -command [itcl::code $this refresh]
	}
	$itk_component(orientom) add landscape -text Landscape
	$itk_component(orientom) add portrait -text Portrait
	$itk_component(orientom) select 0

	itk_component add stretchcb {
		checkbutton $cs.stretchcb \
			-relief flat \
			-text {Stretch to fit} \
			-justify left \
			-anchor w \
			-variable [itcl::scope _globVar($this,stretchcb)] \
			-command [itcl::code $this refresh]
	} { 
		usual
		rename -font -labelfont labelFont Font
	}

	itk_component add postercb {
		checkbutton $cs.postercb \
			-relief flat \
			-text Posterize \
			-justify left \
			-anchor w \
			-variable [itcl::scope _globVar($this,postercb)] \
			-command [itcl::code $this refresh]
	} { 
		usual
		rename -font -labelfont labelFont Font
	}

	itk_component add hpcnt {
		iwidgets::entryfield $cs.hpcnt \
			-labeltext on \
			-textvariable [itcl::scope _globVar($this,hpc)] \
			-validate integer -width 3 \
			-command [itcl::code $this refresh]
	}

	itk_component add vpcnt {
		iwidgets::entryfield $cs.vpcnt \
			-labeltext by \
			-textvariable [itcl::scope _globVar($this,vpc)] \
			-validate integer -width 3 \
			-command [itcl::code $this refresh]
	}

	itk_component add pages {
		label $cs.pages -text pages.
	} { 
		usual
		rename -font -labelfont labelFont Font
	}
	
	set init_opts $args
	
	grid $itk_component(canvasframe) -row 0 -column 0 -rowspan 4 -sticky nsew
	grid $itk_component(propsframe)  -row 0 -column 1 -sticky nsew
	grid $itk_component(outputom)    -row 1 -column 1 -sticky nsew
	grid $itk_component(orientom)    -row 2 -column 1 -sticky nsew
	grid columnconfigure $itk_interior 0 -weight 1
	grid rowconfigure    $itk_interior 3 -weight 1

	grid $itk_component(printerrb) -row 0 -column 0 -sticky nsw
	grid $itk_component(printeref) -row 0 -column 1 -sticky nsw
	grid $itk_component(filerb)    -row 1 -column 0 -sticky nsw
	grid $itk_component(fileef)    -row 1 -column 1 -sticky nsw
	iwidgets::Labeledwidget::alignlabels $itk_component(printeref) $itk_component(fileef)
	grid columnconfigure $itk_component(outputom) 1 -weight 1

	grid $itk_component(paperom)   -row 0 -column 0 -columnspan 2 -sticky nsw
	grid $itk_component(stretchcb) -row 1 -column 0 -sticky nsw
	grid $itk_component(postercb)  -row 2 -column 0 -sticky nsw
	grid $itk_component(hpcnt)     -row 2 -column 1 -sticky nsw
	grid $itk_component(vpcnt)     -row 2 -column 2 -sticky nsw
	grid $itk_component(pages)     -row 2 -column 3 -sticky nsw
	grid columnconfigure $itk_component(propsframe) 3 -weight 1

	eval itk_initialize $args

	bind $itk_component(pages) <Map> +[itcl::code $this _mapEventHandler]
	bind $itk_component(canvas) <Configure> +[itcl::code $this refresh]
}


# ---------------------------------------------------------------
# PUBLIC METHODS
#----------------------------------------------------------------

#<
# This is used to set the canvas that has to be printed.
# A stamp-sized copy will automatically be drawn to show how the
# output would look with the current settings.
#
# In:	canv - The canvas to be printed
# Out:	canvas (attrib) - Holds the canvas to be printed
#>	
itcl::body iwidgets::Canvasprintbox::setcanvas {canv} {
	set canvas $canv
	_update_canvas
}

#<
# Returns the value of the -printercmd or -filename option
# depending on the current setting of -output.
#
# In:	itk_option (attrib)
# Out:	The value of -printercmd or -filename
#>
itcl::body iwidgets::Canvasprintbox::getoutput {} {
	switch $_globVar($this,output) {
	  "file" {
		return $_globVar($this,fileef)
	  }
	  "printer" {
	  	return $_globVar($this,printeref)
	  }
	}
	return ""
}

#<
# Perfrom the actual printing of the canvas using the current settings of
# all the attributes.
#
# In:	itk_option, rotate (attrib)
# Out:	A boolean indicating wether printing was successful
#>
itcl::body iwidgets::Canvasprintbox::print {} {

	global env tcl_platform

	stop

	if {$itk_option(-output) == "file"} {
		set nm $_globVar($this,fileef)
		if {[string range $nm 0 1] == "~/"} {
			set nm "$env(HOME)/[string range $nm 2 end]"
		}
	} else {
		set nm "/tmp/xge[winfo id $canvas]"
	}

	set pr [_calc_print_region]
	set x1 [lindex $pr 0]
	set y1 [lindex $pr 1]
	set x2 [lindex $pr 2]
	set y2 [lindex $pr 3]
	set cx [expr {int(($x2 + $x1) / 2)}]
	set cy [expr {int(($y2 + $y1) / 2)}]
	if {!$itk_option(-stretch)} {
		set ps [_calc_poster_size]
		set pshw [expr {int([lindex $ps 0] / 2)}]
		set pshh [expr {int([lindex $ps 1] / 2)}]
		set x [expr {$cx - $pshw}]
		set y [expr {$cy - $pshh}]
		set w [ezPaperInfo $itk_option(-pagesize) pwidth $itk_option(-orient) $win]
		set h [ezPaperInfo $itk_option(-pagesize) pheight $itk_option(-orient) $win]
	} else {
		set x $x1
		set y $y1
		set w [expr {($x2-$x1) / $_globVar($this,hpc)}]
		set h [expr {($y2-$y1) / $_globVar($this,vpc)}]
	}

	set i 0
	set px $x
	while {$i < $_globVar($this,hpc)} {
		set j 0
		set py $y
		while {$j < $_globVar($this,vpc)} {
			set nm2 [expr {$_globVar($this,hpc) > 1 || $_globVar($this,vpc) > 1 ? "$nm$i.$j" : $nm}]

			if {$itk_option(-stretch)} {
				$canvas postscript \
				  -file $nm2 \
				  -rotate $rotate \
				  -x $px -y $py \
				  -width $w \
				  -height $h \
				  -pagex [ezPaperInfo $itk_option(-pagesize) centerx] \
				  -pagey [ezPaperInfo $itk_option(-pagesize) centery] \
				  -pagewidth [ezPaperInfo $itk_option(-pagesize) pwidth $itk_option(-orient)] \
				  -pageheight [ezPaperInfo $itk_option(-pagesize) pheight $itk_option(-orient)]
			} else {
				$canvas postscript \
				  -file $nm2 \
				  -rotate $rotate \
				  -x $px -y $py \
				  -width $w \
				  -height $h \
				  -pagex [ezPaperInfo $itk_option(-pagesize) centerx] \
				  -pagey [ezPaperInfo $itk_option(-pagesize) centery]
			}

			if {$itk_option(-output) == "printer"} {
				set cmd "$itk_option(-printcmd) < $nm2"
				if {[catch {eval exec $cmd &}]} {
					return 0
				}
			}

			set py [expr {$py + $h}]
			incr j
		}
		set px [expr {$px + $w}]
		incr i
	}

	return 1
}

#<
# Retrieves the current value for all edit fields and updates
# the stamp accordingly. Is useful for Apply-buttons.
#>
itcl::body iwidgets::Canvasprintbox::refresh {} {
	stop
	_update_canvas
        return
}

#<
# Stops the drawing of the "stamp". I'm currently unable to detect
# when a Canvasprintbox gets withdrawn. It's therefore advised
# that you perform a stop before you do something like that.
#>
itcl::body iwidgets::Canvasprintbox::stop {} {

	if {$_reposition != ""} {
		after cancel $_reposition
		set _reposition ""
	}

	if {$_update_attr_id != ""} {
		after cancel $_update_attr_id
		set _update_attr_id ""
	}

        return
}

# ---------------------------------------------------------------
# PROTECTED METHODS
#----------------------------------------------------------------

#
# Calculate the total size the output would be with the current
# settings for "pagesize" and "posterize" (and "hpagecnt" and
# "vpagecnt"). This size will be the size of the printable area,
# some space has been substracted to take into account that a
# page should have borders because most printers can't print on
# the very edge of the paper.
#
# In:	posterize, hpagecnt, vpagecnt, pagesize, orient (attrib)
# Out:	A list of two numbers indicating the width and the height
#	of the total paper area which will be used for printing
#	in pixels.
#
itcl::body iwidgets::Canvasprintbox::_calc_poster_size {} {
	set tpw [expr {[ezPaperInfo $itk_option(-pagesize) \
		pwidth $itk_option(-orient) $win]*$_globVar($this,hpc)}]
	set tph [expr {[ezPaperInfo $itk_option(-pagesize) \
		pheight $itk_option(-orient) $win]*$_globVar($this,vpc)}]

	return "$tpw $tph"
}

#
# Determine which area of the "source" canvas will be printed.
# If "printregion" was set by the "user" this will be used and
# converted to pixel-coordinates. If the user didn't set it
# the bounding box that contains all canvas-items will be used
# instead.
#
# In:	printregion, canvas (attrib)
# Out:	Four floats specifying the region to be printed in
#	pixel-coordinates (topleft & bottomright).
#
itcl::body iwidgets::Canvasprintbox::_calc_print_region {} {
	set printreg [expr {$itk_option(-printregion) != "" 
		? $itk_option(-printregion) : [$canvas bbox all]}]

	if {$printreg != ""} {
		set prx1 [winfo fpixels $canvas [lindex $printreg 0]]
		set pry1 [winfo fpixels $canvas [lindex $printreg 1]]
		set prx2 [winfo fpixels $canvas [lindex $printreg 2]]
		set pry2 [winfo fpixels $canvas [lindex $printreg 3]]

		set res "$prx1 $pry1 $prx2 $pry2"
	} else {
		set res "0 0 0 0"
	}
	
	return $res
}

#
# Calculate the scaling factor needed if the output was
# to be stretched to fit exactly on the page (or pages).
# If stretching is turned off this will always return 1.0.
#
# In:	stretch (attrib)
# Out:	A float specifying the scaling factor.
#
itcl::body iwidgets::Canvasprintbox::_calc_print_scale {} {
	if {$itk_option(-stretch)} {
		set pr [_calc_print_region]
		set prw [expr {[lindex $pr 2] - [lindex $pr 0]}]
		set prh [expr {[lindex $pr 3] - [lindex $pr 1]}]
		set ps [_calc_poster_size]
		set psw [lindex $ps 0]
		set psh [lindex $ps 1]
		set sfx [expr {$psw / $prw}]
		set sfy [expr {$psh / $prh}]
		set sf [expr {$sfx < $sfy ? $sfx : $sfy}]
		return $sf
	} else {
		return 1.0
	}
}

#
# Schedule the thread that makes a copy of the "source"
# canvas to the "stamp".
#
# In:	win, canvas (attrib)
# Out:	-
#
itcl::body iwidgets::Canvasprintbox::_update_canvas {{when later}} {
	if {$win == "" || $canvas == "" || [$canvas find all] == ""} {
		return
	}
	if {$when == "later"} {
		if {$_reposition == ""} {
			set _reposition [after idle [itcl::code $this _update_canvas now]]
		}
		return
	}

	_update_attr now

	#
	# Make a copy of the "source" canvas to the "stamp".
	#
	if {$_globVar($this,hpc) == [llength $vlines] &&
	    $_globVar($this,vpc) == [llength $hlines]} {
		stop
		return
	}	

	$canvw delete all

	set width  [winfo width $canvw]
	set height [winfo height $canvw]
	set ps [_calc_poster_size]

	#
	# Calculate the scaling factor that would be needed to fit the
	# whole "source" into the "stamp". This takes into account the
	# total amount of "paper" that would be needed to print the
	# contents of the "source".
	#
	set xsf [expr {$width/[lindex $ps 0]}]
	set ysf [expr {$height/[lindex $ps 1]}]
	set sf [expr {$xsf < $ysf ? $xsf : $ysf}]
	set w [expr {[lindex $ps 0]*$sf}]
	set h [expr {[lindex $ps 1]*$sf}]
	set x1 [expr {($width-$w)/2}]
	set y1 [expr {($height-$h)/2}]
	set x2 [expr {$x1+$w}]
	set y2 [expr {$y1+$h}]
	set cx [expr {($x2+$x1)/ 2}]
	set cy [expr {($y2+$y1)/ 2}]

	set printreg [_calc_print_region]
	set prx1 [lindex $printreg 0]
	set pry1 [lindex $printreg 1]
	set prx2 [lindex $printreg 2]
	set pry2 [lindex $printreg 3]
	set prcx [expr {($prx2+$prx1)/2}]
	set prcy [expr {($pry2+$pry1)/2}]

	set psf [_calc_print_scale]

	#
	# Copy all items from the "real" canvas to the canvas
	# showing what we'll send to the printer. Bitmaps and
	# texts are not copied because they can't be scaled,
	# a rectangle will be created instead.
	#
	set tsf [expr {$sf * $psf}]
	set dx [expr {$cx-($prcx*$tsf)}]
	set dy [expr {$cy-($prcy*$tsf)}]
	$canvw create rectangle \
		[expr {$x1+0}] \
		[expr {$y1+0}] \
		[expr {$x2-0}] \
		[expr {$y2-0}] -fill white
	set items [eval "$canvas find overlapping $printreg"]

	set itemCount [llength $items]
	for {set cnt 0} {$cnt < $itemCount} {incr cnt} {
		#
		# Determine the item's type and coordinates
		#
		set i [lindex $items $cnt]
		set t [$canvas type $i]
		set crds [$canvas coords $i]

		#
		# Ask for the item's configuration settings and strip
		# it to leave only a list of option names and values.
		#
		set cfg [$canvas itemconfigure $i]
		set cfg2 ""
		foreach c $cfg {
			if {[llength $c] == 5} {
				lappend cfg2 [lindex $c 0] [lindex $c 4]
			}
		}

		#
		# Handle texts and bitmaps differently: they will
		# be represented as rectangles.
		#
		if {$t == "text" || $t == "bitmap" || $t == "window"} {
			set t "rectangle"
			set crds [$canvas bbox $i]
			set cfg2 "-outline {} -fill gray"
		}

		#
		# Remove the arrows from a line item when the scale
		# factor drops below 1/3rd of the original size.
		# This to prevent the arrowheads from dominating the
		# display.
		#
		if {$t == "line" && $tsf < 0.33} {
			lappend cfg2 -arrow none
		}
		
		#
		# Create a copy of the item on the "printing" canvas.
		#
		set i2 [eval "$canvw create $t $crds $cfg2"]
		$canvw scale $i2 0 0 $tsf $tsf
		$canvw move $i2 $dx $dy

		if {($cnt%25) == 0} {
			update
		}
		if {$_reposition == ""} {
			return
		}
	}

	set p $x1
	set i 1
	set vlines {}
	while {$i < $_globVar($this,hpc)} {
		set p [expr {$p + ($w/$_globVar($this,hpc))}]
		set l [$canvw create line $p $y1 $p $y2]
		lappend vlines $l
		incr i
	}

	set p $y1
	set i 1
	set vlines {}
	while {$i < $_globVar($this,vpc)} {
		set p [expr {$p + ($h/$_globVar($this,vpc))}]
		set l [$canvw create line $x1 $p $x2 $p]
		lappend vlines $l
		incr i
	}

	set _reposition ""
}

#
# Update the attributes to reflect changes made in the user-
# interface.
#
# In:	itk_option (attrib) - the attributes to update
#	itk_component (attrib) - the widgets
#	_globVar (common) - the global var holding the state
#		of all radiobuttons and checkboxes.
# Out:	-
#
itcl::body iwidgets::Canvasprintbox::_update_attr {{when "later"}} {
	if {$when != "now"} {
		if {$_update_attr_id == ""} {
			set _update_attr_id [after idle [itcl::code $this _update_attr now]]
		}
		return
	}

        set itk_option(-printcmd)  $_globVar($this,printeref)
        set itk_option(-filename)  $_globVar($this,fileef)
        set itk_option(-output)    $_globVar($this,output)
	set itk_option(-pagesize)  [string tolower [$itk_component(paperom) get]]
	set itk_option(-stretch)   $_globVar($this,stretchcb)
	set itk_option(-posterize) $_globVar($this,postercb)
	set itk_option(-vpagecnt)  $_globVar($this,vpc)
	set itk_option(-hpagecnt)  $_globVar($this,hpc)
	set itk_option(-orient)    [$itk_component(orientom) get]
	set rotate                 [expr {$itk_option(-orient) == "landscape"}]

	if {$_globVar($this,output) == "file"} {
		$itk_component(fileef) configure \
			-state normal -foreground $itk_option(-foreground)
		$itk_component(printeref) configure \
			-state disabled -foreground $itk_option(-disabledforeground)
	} else {
		$itk_component(fileef) configure \
			-state disabled -foreground $itk_option(-disabledforeground)
		$itk_component(printeref) configure \
			-state normal -foreground $itk_option(-foreground)
	}

	set fg [expr {$_globVar($this,postercb) \
		? $itk_option(-foreground) : $itk_option(-disabledforeground)}]

	$itk_component(vpcnt) configure -foreground $fg
	$itk_component(hpcnt) configure -foreground $fg
	$itk_component(pages) configure -foreground $fg

	#
	# Update dependencies among widgets. (For example: disabling
	# an entry-widget when its associated checkbox-button is used
	# to turn of the option (the entry's value is not needed
	# anymore and this should be reflected in the fact that it
	# isn't possible to change it anymore).
	#
	# former method:_update_widgets/_update_UI
	#
	set state [expr {$itk_option(-posterize) ? "normal" : "disabled"}]
	$itk_component(vpcnt) configure -state $state
	$itk_component(hpcnt) configure -state $state
	$itk_component(paperom) select "*[string range $itk_option(-pagesize) 1 end]"

	set _update_attr_id ""
}

#
# Gets called when the CanvasPrintBox-widget gets mapped.
#
itcl::body iwidgets::Canvasprintbox::_mapEventHandler {} {
	set win $itk_interior
	set canvw $itk_component(canvas)
	if {$canvas != ""} {
		setcanvas $canvas
	}
	_update_attr
}

#
# Destroy this object and its associated widgets.
#
itcl::body iwidgets::Canvasprintbox::destructor {} {
	stop
}

#
# Hold the information about common paper sizes. A bit of a hack, but it
# should be possible to add your own if you take a look at it.
#
itcl::body iwidgets::Canvasprintbox::ezPaperInfo {size {attr ""} \
	{orient "portrait"} {window ""}} {
    
	set size [string tolower $size]
	set attr [string tolower $attr]
	set orient [string tolower $orient]
	
	case $size in {
		types {
			return "A5 A4 A3 A2 A1 Legal Letter"
		}
		a5 {
			set paper(x1) "1.0c"
			set paper(y1) "1.0c"
			set paper(x2) "13.85c"
			set paper(y2) "20.0c"
			set paper(pheight) "19.0c"
			set paper(pwidth) "12.85c"
			set paper(height) "21.0c"
			set paper(width) "14.85c"
			set paper(centerx) "7.425c"
			set paper(centery) "10.5c"
		}
		a4 {
			set paper(x1) "1.0c"
			set paper(y1) "1.0c"
			set paper(x2) "20.0c"
			set paper(y2) "28.7c"
			set paper(pheight) "27.7c"
			set paper(pwidth) "19.0c"
			set paper(height) "29.7c"
			set paper(width) "21.0c"
			set paper(centerx) "10.5c"
			set paper(centery) "14.85c"
		}
		a3 {
			set paper(x1) "1.0c"
			set paper(y1) "1.0c"
			set paper(x2) "28.7c"
			set paper(y2) "41.0c"
			set paper(pheight) "40.0c"
			set paper(pwidth) "27.7c"
			set paper(height) "42.0c"
			set paper(width) "29.7c"
			set paper(centerx) "14.85c"
			set paper(centery)  "21.0c"
		}
		a2 {
			set paper(x1) "1.0c"
			set paper(y1) "1.0c"
			set paper(x2) "41.0c"
			set paper(y2) "58.4c"
			set paper(pheight) "57.4c"
			set paper(pwidth) "40.0c"
			set paper(height) "59.4c"
			set paper(width) "42.0c"
			set paper(centerx) "21.0c"
			set paper(centery)  "29.7c"
		}
		a1 {
			set paper(x1) "1.0c"
			set paper(y1) "1.0c"
			set paper(x2) "58.4c"
			set paper(y2) "83.0c"
			set paper(pheight) "82.0c"
			set paper(pwidth) "57.4c"
			set paper(height) "84.0c"
			set paper(width) "59.4c"
			set paper(centerx) "29.7c"
			set paper(centery)  "42.0c"
		}
		legal {
			set paper(x1) "0.2i"
			set paper(y1) "0.2i"
			set paper(x2) "8.3i"
			set paper(y2) "13.8i"
			set paper(pheight) "13.6i"
			set paper(pwidth) "8.1i"
			set paper(height) "14.0i"
			set paper(width) "8.5i"
			set paper(centerx) "4.25i"
			set paper(centery) "7.0i"
		}
		letter {
			set paper(x1) "0.2i"
			set paper(y1) "0.2i"
			set paper(x2) "8.3i"
			set paper(y2) "10.8i"
			set paper(pheight) "10.6i"
			set paper(pwidth) "8.1i"
			set paper(height) "11.0i"
			set paper(width) "8.5i"
			set paper(centerx) "4.25i"
			set paper(centery) "5.5i"
		}
		default {
			error "ezPaperInfo: Unknown paper type ($type)"
		}
	}
	
	set inv(x1) "y1"
	set inv(x2) "y2"
	set inv(y1) "x1"
	set inv(y2) "x2"
	set inv(pwidth) "pheight"
	set inv(pheight) "pwidth"
	set inv(width) "height"
	set inv(height) "width"
	set inv(centerx) "centery"
	set inv(centery) "centerx"
	
	case $orient in {
		landscape {
			set res $paper($inv($attr))
		}
		portrait {
			set res $paper($attr)
		}
		default {
			error "ezPaperInfo: orientation should be\
				portrait or landscape (not $orient)"
		}
	}
	
	if {$window != ""} {
		set res [winfo fpixels $window $res]
	}
	
	return $res
} 

Added library/canvasprintdialog.itk.























































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#
# CanvasPrintDialog v1.5
# ----------------------------------------------------------------------
# Implements a print dialog for printing the contents of a canvas widget
# to a printer or a file. It is possible to specify page orientation, the
# number of pages to print the image on and if the output should be
# stretched to fit the page. The CanvasPrintDialog is derived from the
# Dialog class and is composed of a CanvasPrintBox with attributes set to
# manipulate the dialog buttons.
# 
# ----------------------------------------------------------------------
#  AUTHOR: Tako Schotanus              EMAIL: Tako.Schotanus@bouw.tno.nl
# ----------------------------------------------------------------------
#				   Copyright (c) 1995  Tako Schotanus
# ======================================================================
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 
# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN 
# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 
# DAMAGE.
#
# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, 
# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
# FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
# ======================================================================

#
# Option database default resources:
#
option add *Canvasprintdialog.filename "canvas.ps" widgetDefault
option add *Canvasprintdialog.hPageCnt 1 widgetDefault
option add *Canvasprintdialog.orient landscape widgetDefault
option add *Canvasprintdialog.output printer widgetDefault
option add *Canvasprintdialog.pageSize A4 widgetDefault
option add *Canvasprintdialog.posterize 0 widgetDefault
option add *Canvasprintdialog.printCmd lpr widgetDefault
option add *Canvasprintdialog.printRegion "" widgetDefault
option add *Canvasprintdialog.vPageCnt 1 widgetDefault
option add *Canvasprintdialog.title "Canvas Print Dialog" widgetDefault
option add *Canvasprintdialog.master "." widgetDefault

#
# Usual options.
#
itk::usual Canvasprintdialog {
	keep -background -cursor -foreground -modality 
}

# ------------------------------------------------------------------
# CANVASPRINTDIALOG
# ------------------------------------------------------------------
itcl::class iwidgets::Canvasprintdialog {
	inherit iwidgets::Dialog

	constructor {args} {}   
	destructor {}

	method deactivate {args} {}
	method getoutput {} {}
	method setcanvas {canv} {}
	method refresh {} {}
	method print {} {}
}

#
# Provide a lowercased access method for the Canvasprintdialog class.
# 
proc ::iwidgets::canvasprintdialog {args} {
	uplevel ::iwidgets::Canvasprintdialog $args
}

# ------------------------------------------------------------------
# CONSTRUCTOR 
#
# Create new file selection dialog.
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintdialog::constructor {args} {
	component hull configure -borderwidth 0

	# 
	# Instantiate a file selection box widget.
	#
	itk_component add cpb {
		iwidgets::Canvasprintbox $itk_interior.cpb
	} {
		usual
		keep -printregion -output -printcmd -filename -pagesize \
		     -orient -stretch -posterize -hpagecnt -vpagecnt
	}
	pack $itk_component(cpb) -fill both -expand yes

	#
	# Hide the apply and help buttons.
	#
	buttonconfigure OK -text Print
	buttonconfigure Apply -command [itcl::code $this refresh] -text Refresh
	hide Help

	eval itk_initialize $args
}   

# ------------------------------------------------------------------
# METHOD: deactivate
#
# Redefines method of dialog shell class. Stops the drawing of the
# thumbnail (when busy) upon deactivation of the dialog.
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintdialog::deactivate {args} {
	$itk_component(cpb) stop
	return [eval Shell::deactivate $args]
}

# ------------------------------------------------------------------
# METHOD: getoutput
#
# Thinwrapped method of canvas print box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintdialog::getoutput {} {
	return [$itk_component(cpb) getoutput]
}

# ------------------------------------------------------------------
# METHOD: setcanvas
#
# Thinwrapped method of canvas print box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintdialog::setcanvas {canv} {
	return [$itk_component(cpb) setcanvas $canv]
}

# ------------------------------------------------------------------
# METHOD: refresh
#
# Thinwrapped method of canvas print box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintdialog::refresh {} {
	return [$itk_component(cpb) refresh]
}

# ------------------------------------------------------------------
# METHOD: print
#
# Thinwrapped method of canvas print box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintdialog::print {} {
	return [$itk_component(cpb) print]
}

Added library/checkbox.itk.











































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
#
# Checkbox
# ----------------------------------------------------------------------
# Implements a checkbuttonbox.  Supports adding, inserting, deleting,
# selecting, and deselecting of checkbuttons by tag and index.
#
# ----------------------------------------------------------------------
#  AUTHOR: John A. Tucker                EMAIL: jatucker@spd.dsccc.com
#
# ----------------------------------------------------------------------
#            Copyright (c) 1997 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================


#
# Use option database to override default resources of base classes.
#
option add *Checkbox.labelMargin	10	widgetDefault
option add *Checkbox.labelFont     \
      "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"  widgetDefault
option add *Checkbox.labelPos		nw	widgetDefault
option add *Checkbox.borderWidth	2	widgetDefault
option add *Checkbox.relief		groove	widgetDefault

#
# Usual options.
#
itk::usual Checkbox {
    keep -background -borderwidth -cursor -foreground -labelfont
}

# ------------------------------------------------------------------
#                            CHECKBOX
# ------------------------------------------------------------------
itcl::class iwidgets::Checkbox {
    inherit iwidgets::Labeledframe

    constructor {args} {}

    itk_option define -orient orient Orient vertical

    public {
      method add {tag args}
      method insert {index tag args}
      method delete {index}
      method get {{index ""}}
      method index {index}
      method select {index}
      method deselect {index}
      method flash {index}
      method toggle {index}
      method buttonconfigure {index args}
  }

  private {

      method gettag {index}      ;# Get the tag of the checkbutton associated
                                 ;# with a numeric index

      variable _unique 0         ;# Unique id for choice creation.
      variable _buttons {}       ;# List of checkbutton tags.
      common buttonVar           ;# Array of checkbutton "-variables"
  }
}

#
# Provide a lowercased access method for the Checkbox class.
#
proc ::iwidgets::checkbox {pathName args} {
    uplevel ::iwidgets::Checkbox $pathName $args
}

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::constructor {args} {

    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                            OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -orient
#
# Allows the user to orient the checkbuttons either horizontally
# or vertically.  Added by Chad Smith (csmith@adc.com) 3/10/00.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Checkbox::orient {
  if {$itk_option(-orient) == "horizontal"} {
    foreach tag $_buttons {
      pack $itk_component($tag) -side left -anchor nw -padx 4 -expand 1
    }
  } elseif {$itk_option(-orient) == "vertical"} {
    foreach tag $_buttons {
      pack $itk_component($tag) -side top -anchor w -padx 4 -expand 0
    }
  } else {
    error "Bad orientation: $itk_option(-orient).  Should be\
      \"horizontal\" or \"vertical\"."
  }
}


# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: index index
#
# Searches the checkbutton tags in the checkbox for the one with the
# requested tag, numerical index, or keyword "end".  Returns the 
# choices's numerical index if found, otherwise error.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::index {index} {
    if {[llength $_buttons] > 0} {
        if {[regexp {(^[0-9]+$)} $index]} {
            if {$index < [llength $_buttons]} {
                return $index
            } else {
                error "Checkbox index \"$index\" is out of range"
            }

        } elseif {$index == "end"} {
            return [expr {[llength $_buttons] - 1}]

        } else {
            if {[set idx [lsearch $_buttons $index]] != -1} {
                return $idx
            }

            error "bad Checkbox index \"$index\": must be number, end,\
                    or pattern"
        }

    } else {
        error "Checkbox \"$itk_component(hull)\" has no checkbuttons"
    }
}

# ------------------------------------------------------------------
# METHOD: add tag ?option value option value ...?
#
# Add a new tagged checkbutton to the checkbox at the end.  The method 
# takes additional options which are passed on to the checkbutton
# constructor.  These include most of the typical checkbutton 
# options.  The tag is returned.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::add {tag args} {
    itk_component add $tag {
        eval checkbutton $itk_component(childsite).cb[incr _unique] \
            -variable [list [itcl::scope buttonVar($this,$tag)]] \
            -anchor w \
            -justify left \
            -highlightthickness 0 \
            $args
    } { 
      usual
      keep -command -disabledforeground -selectcolor -state
      ignore -highlightthickness -highlightcolor
      rename -font -labelfont labelFont Font
    }

    # Redraw the buttons with the proper orientation.
    if {$itk_option(-orient) == "vertical"} {
      pack $itk_component($tag) -side top -anchor w -padx 4 -expand 0
    } else {
      pack $itk_component($tag) -side left -anchor nw -expand 1
    }

    lappend _buttons $tag

    return $tag
}

# ------------------------------------------------------------------
# METHOD: insert index tag ?option value option value ...?
#
# Insert the tagged checkbutton in the checkbox just before the 
# one given by index.  Any additional options are passed on to the
# checkbutton constructor.  These include the typical checkbutton
# options.  The tag is returned.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::insert {index tag args} {
    itk_component add $tag {
        eval checkbutton $itk_component(childsite).cb[incr _unique] \
            -variable [list [itcl::scope buttonVar($this,$tag)]] \
            -anchor w \
            -justify left \
            -highlightthickness 0 \
            $args
    }  { 
      usual
      ignore -highlightthickness -highlightcolor
      rename -font -labelfont labelFont Font
    }

    set index [index $index]
    set before [lindex $_buttons $index]
    set _buttons [linsert $_buttons $index $tag]

    pack $itk_component($tag) -anchor w -padx 4 -before $itk_component($before)

    return $tag
}

# ------------------------------------------------------------------
# METHOD: delete index
#
# Delete the specified checkbutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::delete {index} {

    set tag [gettag $index]
    set index [index $index]
    destroy $itk_component($tag)
    set _buttons [lreplace $_buttons $index $index]

    if { [info exists buttonVar($this,$tag)] == 1 } {
	unset buttonVar($this,$tag)
    }
}

# ------------------------------------------------------------------
# METHOD: select index
#
# Select the specified checkbutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::select {index} {
    set tag [gettag $index]
    #-----------------------------------------------------------
    # BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/30/99
    #-----------------------------------------------------------
    # This method should only invoke the checkbutton if it's not
    # already selected.  Check its associated variable, and if
    # it's set, then just ignore and return.
    #-----------------------------------------------------------
    if {[set [itcl::scope buttonVar($this,$tag)]] == 
	[[component $tag] cget -onvalue]} {
      return
    }
    $itk_component($tag) invoke
}

# ------------------------------------------------------------------
# METHOD: toggle index
#
# Toggle a specified checkbutton between selected and unselected
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::toggle {index} {
    set tag [gettag $index]
    $itk_component($tag) toggle
}

# ------------------------------------------------------------------
# METHOD: get
#
# Return the value of the checkbutton with the given index, or a
# list of all checkbutton values in increasing order by index.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::get {{index ""}} {
    set result {}

    if {$index == ""} {
	foreach tag $_buttons {
	    if {$buttonVar($this,$tag)} {
		lappend result $tag
	    }
	}
    } else {
        set tag [gettag $index]
	set result $buttonVar($this,$tag)
    }

    return $result
}

# ------------------------------------------------------------------
# METHOD: deselect index
#
# Deselect the specified checkbutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::deselect {index} {
    set tag [gettag $index]
    $itk_component($tag) deselect
}

# ------------------------------------------------------------------
# METHOD: flash index
#
# Flash the specified checkbutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::flash {index} {
    set tag [gettag $index]
    $itk_component($tag) flash  
}

# ------------------------------------------------------------------
# METHOD: buttonconfigure index ?option? ?value option value ...?
#
# Configure a specified checkbutton.  This method allows configuration 
# of checkbuttons from the Checkbox level.  The options may have any 
# of the values accepted by the add method.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::buttonconfigure {index args} { 
    set tag [gettag $index]
    eval $itk_component($tag) configure $args
}

# ------------------------------------------------------------------
# METHOD: gettag index
#
# Return the tag of the checkbutton associated with a specified
# numeric index
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::gettag {index} {
    return [lindex $_buttons [index $index]]
}

Added library/colors.itcl.



































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
#
# colors
# ----------------------------------------------------------------------
# The colors class encapsulates several color related utility functions.
# Class level scope resolution must be used inorder to access the static
# member functions.
#
#   USAGE:
#     set hsb [colors::rgbToHsb [winfo rgb . bisque]]
#
# ----------------------------------------------------------------------
#  AUTHOR: Mark L. Ulferts               EMAIL: mulferts@spd.dsccc.com
#
#  @(#) $Id: colors.itcl,v 1.2 2001/08/15 18:33:55 smithc Exp $
# ----------------------------------------------------------------------
#                   Copyright (c) 1995  Mark L. Ulferts
# ======================================================================
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 
# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN 
# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 
# DAMAGE.
#
# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, 
# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
# FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
# ======================================================================

namespace eval iwidgets::colors {

    # ------------------------------------------------------------------
    # PROCEDURE: rgbToNumeric
    #
    # Returns the numeric value for a list of red, green, and blue.
    # ------------------------------------------------------------------
    proc rgbToNumeric {rgb} {
	if {[llength $rgb] != 3} {
	    error "bad arg: \"$rgb\", should be list of red, green, and blue"
	}

	return [format "#%04x%04x%04x" \
		[lindex $rgb 0] [lindex $rgb 1] [lindex $rgb 2]]
    }

    # ------------------------------------------------------------------
    # PROCEDURE: rgbToHsb
    #
    # The procedure below converts an RGB value to HSB.  It takes red, 
    # green, and blue components (0-65535) as arguments, and returns a 
    # list containing HSB components (floating-point, 0-1) as result.  
    # The code here is a copy of the code on page 615 of "Fundamentals
    # of Interactive Computer Graphics" by Foley and Van Dam.
    # ------------------------------------------------------------------
    proc rgbToHsb {rgb} {
        if {[llength $rgb] != 3} {
            error "bad arg: \"$rgb\", should be list of red, green, and blue"
        }

        set r [expr {[lindex $rgb 0]/65535.0}]
        set g [expr {[lindex $rgb 1]/65535.0}]
        set b [expr {[lindex $rgb 2]/65535.0}]

        set max 0
        if {$r > $max} {set max $r}
        if {$g > $max} {set max $g}
        if {$b > $max} {set max $b}

        set min 65535
        if {$r < $min} {set min $r}
        if {$g < $min} {set min $g}
        if {$b < $min} {set min $b}

        if {$max != 0} {
            set sat  [expr {($max-$min)/$max}]
        } else {
            set sat 0
        }
        if {$sat == 0} {
            set hue 0
        } else {
            set rc [expr {($max-$r)/($max-$min)}]
            set gc [expr {($max-$g)/($max-$min)}]
            set bc [expr {($max-$b)/($max-$min)}]

            if {$r == $max} {
                set hue [expr {$bc-$gc}]
            } elseif {$g == $max} {
                set hue [expr {2+$rc-$bc}]
            } elseif {$b == $max} {
                set hue [expr {4+$gc-$rc}]
            }
            set hue [expr {$hue*0.1666667}]
            if {$hue < 0} {set hue [expr {$hue+1.0}]}
        }
        return [list $hue $sat $max]
    }

    # ------------------------------------------------------------------
    # PROCEDURE: hsbToRgb
    #
    # The procedure below converts an HSB value to RGB.  It takes hue, 
    # saturation, and value components (floating-point, 0-1.0) as 
    # arguments, and returns a list containing RGB components (integers, 
    # 0-65535) as result.  The code here is a copy of the code on page 
    # 616 of "Fundamentals of Interactive Computer Graphics" by Foley 
    # and Van Dam.
    # ------------------------------------------------------------------
    proc hsbToRgb {hsb} {

	if {[llength $hsb] != 3} {
	    error "bad arg: \"$hsb\", should be list of hue, saturation, and brightness"
	}

	set hue [lindex $hsb 0]
	set sat [lindex $hsb 1]
	set value [lindex $hsb 2]

	set v [format %.0f [expr {65535.0*$value}]]
	if {$sat == 0} {
	    return "$v $v $v"
	} else {
	    set hue [expr {$hue*6.0}]
	    if {$hue >= 6.0} {
		set hue 0.0
	    }
	    scan $hue. %d i
	    set f [expr {$hue-$i}]
	    set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
	    set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
	    set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
	    case $i \
		    0 {return "$v $t $p"} \
		    1 {return "$q $v $p"} \
		    2 {return "$p $v $t"} \
		    3 {return "$p $q $v"} \
		    4 {return "$t $p $v"} \
		    5 {return "$v $p $q"}
	    error "i value $i is out of range"
	}
    }

    # ------------------------------------------------------------------
	#
	# PROCEDURE: topShadow bgColor
	#
	# This method computes a lighter shadow variant of bgColor.
	# It wants to decrease the saturation to 25%. But if there is
	# no saturation (as in gray colors) it tries to turn the 
	# brightness up by 10%. It maxes the brightness at 1.0 to
	# avoid bogus colors...
	#
	# bgColor is converted to HSB where the calculations are 
	# made. Then converted back to an rgb color number (hex fmt)
	#
    # ------------------------------------------------------------------
	proc topShadow { bgColor } {

		set hsb [rgbToHsb [winfo rgb . $bgColor]]

		set saturation [lindex $hsb 1]
		set brightness [lindex $hsb 2]

		if { $brightness < 0.9 } {
			# try turning the brightness up first.
			set brightness [expr {$brightness * 1.1}]
		} else {
			# otherwise fiddle with saturation
			set saturation [expr {$saturation * 0.25}]
		}

		set hsb [lreplace $hsb 1 1 [set saturation]]
		set hsb [lreplace $hsb 2 2 [set brightness]]

		set rgb [hsbToRgb $hsb]
		set color [rgbToNumeric $rgb]
		return $color
	}

	
    # ------------------------------------------------------------------
	#
	# PROC: bottomShadow bgColor
	#
	#
	# This method computes a darker shadow variant of bg color.
	# It takes the brightness and decreases it to 80% of its
	# original value.
	#
	# bgColor is converted to HSB where the calculations are 
	# made. Then converted back to an rgb color number (hex fmt)
	#
    # ------------------------------------------------------------------
	proc bottomShadow { bgColor } {

		set hsb [rgbToHsb [winfo rgb . $bgColor]]
		set hsb [lreplace $hsb 2 2 [expr {[lindex $hsb 2] * 0.8}]]
		set rgb [hsbToRgb $hsb]
		set color [rgbToNumeric $rgb]
		return $color
	}
}

Added library/combobox.itk.













































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
# Combobox
# ----------------------------------------------------------------------
# Implements a Combobox widget. A Combobox has 2 basic styles: simple and
# dropdown. Dropdowns display an entry field with an arrow button to the 
# right of it. When the arrow button is pressed a selectable list of
# items is popped up. A simple Combobox displays an entry field and a listbox 
# just beneath it which is always displayed. In both types, if the user 
# selects an item in the listbox, the contents of the entry field are 
# replaced with the text from the selected item. If the Combobox is 
# editable, the user can type in the entry field and when <Return> is
# pressed the item will be inserted into the list.
#
# WISH LIST:
#	This section lists possible future enhancements.  
#
#	  Combobox 1.x:
#		  - convert bindings to bindtags.
#
# ----------------------------------------------------------------------
#  ORIGINAL AUTHOR: John S. Sigler
# ----------------------------------------------------------------------
#  CURRENT MAINTAINER: Chad Smith	EMAIL: csmith@adc.com, itclguy@yahoo.com
#
#					Copyright (c) 1995	John S. Sigler
#					Copyright (c) 1997	Mitch Gorman
# ======================================================================
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 
# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN 
# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 
# DAMAGE.
#
# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, 
# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
# FITNESS FOR A PARTICULAR PURPOSE.	 THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
# ======================================================================

#
# Default resources.
#
option add *Combobox.borderWidth 2 widgetDefault
option add *Combobox.labelPos wn widgetDefault
option add *Combobox.listHeight 150 widgetDefault
option add *Combobox.hscrollMode dynamic widgetDefault
option add *Combobox.vscrollMode dynamic widgetDefault

#
# Usual options.
#
itk::usual Combobox {
    keep -background -borderwidth -cursor -foreground -highlightcolor \
	-highlightthickness -insertbackground -insertborderwidth \
	-insertofftime -insertontime -insertwidth -labelfont -popupcursor \
	-selectbackground -selectborderwidth -selectforeground \
	-textbackground -textfont
}

# ------------------------------------------------------------------
#							 COMBOBOX
# ------------------------------------------------------------------
itcl::class iwidgets::Combobox {
    inherit iwidgets::Entryfield
    
    constructor {args} {}
    destructor {}

    itk_option define -arrowrelief arrowRelief Relief raised
    itk_option define -completion completion Completion true
    itk_option define -dropdown dropdown Dropdown true
    itk_option define -editable editable Editable true
    itk_option define -grab grab Grab local
    itk_option define -listheight listHeight Height 150
    itk_option define -margin margin Margin 1
    itk_option define -popupcursor popupCursor Cursor arrow
    itk_option define -selectioncommand selectionCommand SelectionCommand {}
    itk_option define -state state State normal
    itk_option define -unique unique Unique true

    public method clear {{component all}}
    public method curselection {}
    public method delete {component first {last {}}}
    public method get {{index {}}}
    public method getcurselection {}
    public method insert {component index args}
    public method invoke {}
    public method justify {direction}
    public method see {index}
    public method selection {option first {last {}}}
    public method size {}
    public method sort {{mode ascending}}
    public method xview {args}
    public method yview {args}

    protected method _addToList {}
    protected method _createComponents {}
    protected method _deleteList {first {last {}}}
    protected method _deleteText {first {last {}}}
    protected method _doLayout {{when later}}
    protected method _drawArrow {}
    protected method _dropdownBtnRelease {{window {}} {x 1} {y 1}}
    protected method _ignoreNextBtnRelease {ignore}
    protected method _next {}
    protected method _packComponents {{when later}}
    protected method _positionList {}
    protected method _postList {}
    protected method _previous {}
    protected method _resizeArrow {}
    protected method _selectCmd {}
    protected method _toggleList {}
    protected method _unpostList {}
    protected method _commonBindings {}
    protected method _dropdownBindings {}
    protected method _simpleBindings {}
    protected method _listShowing {{val ""}}

    private method _bs {}
    private method _lookup {key}
    private method _slbListbox {}
    private method _stateSelect {}

    private variable _doit 0;
    private variable _inbs 0;
    private variable _inlookup 0;
    private variable _currItem {};			 ;# current selected item.
    private variable _ignoreRelease false	 ;# next button release ignored.
    private variable _isPosted false;		 ;# is the dropdown popped up.
    private variable _repacking {}	  ;# non-null => _packComponents pending.
    private variable _grab                ;# used to restore grabs
    private variable _next_prevFLAG 0 ;# Used in _lookup to fix SF Bug 501300
    private common _listShowing
    private common count 0
}	 

#
# Provide a lowercase access method for the Combobox class.
# 
proc ::iwidgets::combobox {pathName args} {
    uplevel ::iwidgets::Combobox $pathName $args
}

# ------------------------------------------------------------------
#						CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::constructor {args} {
    set _listShowing($this) 0
    set _grab(window) ""
    set _grab(status) ""

    # combobox is different as all components are created 
    # after determining what the dropdown style is...

    # configure args
    eval itk_initialize $args
    
    # create components that are dependent on options 
    # (Scrolledlistbox, arrow button) and pack them.
    if {$count == 0} {
	image create bitmap downarrow -data {
	    #define down_width 16
	    #define down_height 16
	    static unsigned char down_bits[] = {
		0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 
		0x00, 0x00, 0x00, 0x00, 0xfc, 0x7f, 0xf8, 0x3f, 
		0xf0, 0x1f, 0xe0, 0x0f, 0xc0, 0x07, 0x80, 0x03, 
		0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
	    };
	}
	image create bitmap uparrow -data {
	    #define up_width 16
	    #define up_height 16
	    static unsigned char up_bits[] = {
		0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 
		0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 
		0xfc, 0x1f, 0xfe, 0x3f, 0x00, 0x00, 0x00, 0x00,
		0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
	    };
	}
    }
    incr count
    _doLayout
}

# ------------------------------------------------------------------
#						   DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::destructor {} {
    # catch any repacking that may be waiting for idle time
    if {$_repacking != ""} {
	after cancel $_repacking
    }
    incr count -1
    if {$count == 0} {
	image delete uparrow
	image delete downarrow
    }
}

# ================================================================
#							OPTIONS
# ================================================================

# --------------------------------------------------------------------
# OPTION:  -arrowrelief
#
# Relief style used on the arrow button.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::arrowrelief {}

# --------------------------------------------------------------------
# OPTION:  -completion
#
# Relief style used on the arrow button.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::completion {
    switch -- $itk_option(-completion) {
	0 - no - false - off { }
	1 - yes - true - on { }
	default {
	    error "bad completion option \"$itk_option(-completion)\":\
					   should be boolean"
	}
    }
}

# --------------------------------------------------------------------
# OPTION:  -dropdown  
#
# Boolean which determines the Combobox style: dropdown or simple.
# Because the two style's lists reside in different toplevel widgets
# this is more complicated than it should be.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::dropdown {
    switch -- $itk_option(-dropdown) {
	1 - yes - true - on {
	    if {[winfo exists $itk_interior.list]} {
		set vals [$itk_component(list) get 0 end]
		destroy $itk_component(list)
		_doLayout
		if [llength $vals] {
		    eval insert list end $vals
		}
	    }
	}
	0 - no - false - off {
	    if {[winfo exists $itk_interior.popup.list]} {
		set vals [$itk_component(list) get 0 end]
		catch {destroy $itk_component(arrowBtn)}
		destroy $itk_component(popup)  ;# this deletes the list too
		_doLayout
		if [llength $vals] {
		    eval insert list end $vals
		}
	    }
	}
	default {
	    error "bad dropdown option \"$itk_option(-dropdown)\":\
					   should be boolean"
	}
    }
}

# --------------------------------------------------------------------
# OPTION: -editable	 
#
# Boolean which allows/disallows user input to the entry field area.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::editable {
    switch -- $itk_option(-editable) {
	1 - true - yes - on {
	    switch -- $itk_option(-state) {
		normal {
		    $itk_component(entry) configure -state normal
		}
	    }
	}
	0 - false - no - off {
	    $itk_component(entry) configure -state readonly
	}
	default {
	    error "bad editable option \"$itk_option(-editable)\":\
				   should be boolean"
	}
    }
}

# --------------------------------------------------------------------
# OPTION:  -grab
#
# grab-state of megawidget
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::grab {
    switch -- $itk_option(-grab) {
	local { }
	global { }
	default {
	    error "bad grab value \"$itk_option(-grab)\":\
				   must be global or local"
	}
    }
}

# --------------------------------------------------------------------
# OPTION: -listheight  
#
# Listbox height in pixels. (Need to integrate the scrolledlistbox
# -visibleitems option here - at least for simple listbox.)
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::listheight {}

# --------------------------------------------------------------------
# OPTION:  -margin
#
# Spacer between the entry field and arrow button of dropdown style
# Comboboxes.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::margin {
    grid columnconfigure $itk_interior 0 -minsize $itk_option(-margin)
}

# --------------------------------------------------------------------
# OPTION:  -popupcursor
#
# Set the cursor for the popup list.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::popupcursor {}

# --------------------------------------------------------------------
# OPTION:  -selectioncommand
#
# Defines the proc to be called when an item is selected in the list.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::selectioncommand {}

# --------------------------------------------------------------------
# OPTION:  -state
#
# overall state of megawidget
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::state {
    switch -- $itk_option(-state) {
	disabled {
	    $itk_component(entry) configure -state disabled
	}
	normal {
	    switch -- $itk_option(-editable) {
		1 - true - yes - on {
		    $itk_component(entry) configure -state normal
		}
		0 - false - no - off {
		    $itk_component(entry) configure -state readonly
		}
	    }
	}
	readonly {
	  $itk_component(entry) configure -state readonly
	}
	default {
	    error "bad state value \"$itk_option(-state)\":\
				   must be normal  or disabled"
	}
    }
    if {[info exists itk_component(arrowBtn)]} {
	$itk_component(arrowBtn) configure -state $itk_option(-state)
    }
}

# --------------------------------------------------------------------
# OPTION: -unique  
#
# Boolean which disallows/allows adding duplicate items to the listbox.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::unique {
    # boolean error check
    switch -- $itk_option(-unique) {
	1 - true - yes - on { }
	0 - false - no - off { }
	default {
	    error "bad unique value \"$itk_option(-unique)\":\
				   should be boolean"
	}
    }
}

# =================================================================
#							 METHODS
# =================================================================

# ------------------------------------------------------
#  PUBLIC METHOD: clear ?component?
#
#  Remove all elements from the listbox, all contents
#  from the entry component, or both (if all).
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::clear {{component all}} {
    switch -- $component {
	entry {
	    iwidgets::Entryfield::clear
	}
	list {
	    delete list 0 end
	}
	all {
	    delete list 0 end
	    iwidgets::Entryfield::clear
	}
	default {
	    error "bad Combobox component \"$component\":\
				   must be entry, list, or all."
	}
    }
    return
}

# ------------------------------------------------------
# PUBLIC METHOD: curselection
#
# Return the current selection index.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::curselection {} {
    return [$itk_component(list) curselection]
}

# ------------------------------------------------------
# PUBLIC METHOD: delete component first ?last?
#
# Delete an item or items from the listbox OR delete
# text from the entry field. First argument determines
# which component deletion occurs in - valid values are
# entry or list.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::delete {component first {last {}}} {
    switch -- $component {
	entry {
	    if {$last == {}} {
	      set last [expr {$first + 1}]
	    }
	    iwidgets::Entryfield::delete $first $last
	}
	list {
	    _deleteList $first $last
	}
	default {
	    error "bad Combobox component \"$component\":\
				   must be entry or list."
	}
    }
}

# ------------------------------------------------------
# PUBLIC METHOD: get ?index?
#
#
# Retrieve entry contents if no args OR use args as list 
# index and retrieve list item at index .
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::get {{index {}}} {
    # no args means to get the current text in the entry field area
    if {$index == {}} {
	iwidgets::Entryfield::get
    } else {
	eval $itk_component(list) get $index
    }
}

# ------------------------------------------------------
# PUBLIC METHOD: getcurselection
#
# Return currently selected item in the listbox. Shortcut
# version of get curselection command combination.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::getcurselection {} {
    return [$itk_component(list) getcurselection]
}

# ------------------------------------------------------------------
# PUBLIC METHOD: invoke
#
# Pops up or down a dropdown combobox.
# 
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::invoke {} {
    if {$itk_option(-dropdown)} {
	return [_toggleList]
    }
    return 
}

# ------------------------------------------------------------
# PUBLIC METHOD: insert comonent index string ?string ...?
#
# Insert an item into the listbox OR text into the entry area.
# Valid component names are entry or list.
#
# ------------------------------------------------------------
itcl::body iwidgets::Combobox::insert {component index args} {
    set nargs [llength $args]

    if {$nargs == 0} {
	error "no value given for parameter \"string\" in function\
			   \"Combobox::insert\""
    } 

    switch -- $component {
	entry {
	    if { $nargs > 1} {
		error "called function \"Combobox::insert entry\"\
					   with too many arguments"
	    } else {
		if {$itk_option(-state) == "normal"} {
		    eval iwidgets::Entryfield::insert $index $args
		    #RZ [itcl::code $this _lookup ""]
		    eval [itcl::code $this _lookup ""]
		}
	    }
	}
	list {
	    if {$itk_option(-state) == "normal"} {
		eval $itk_component(list) insert $index $args
	    }
	}
	default {
	    error "bad Combobox component \"$component\": must\
				   be entry or list."
	}
    }
}

# ------------------------------------------------------
# PUBLIC METHOD: justify direction
#
# Wrapper for justifying the listbox items in one of
# 4 directions:	 top, bottom, left, or right.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::justify {direction} {
    return [$itk_component(list) justify $direction]
}

# ------------------------------------------------------------------
# PUBLIC METHOD: see index
#
# Adjusts the view such that the element given by index is visible.
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::see {index} {
    return [$itk_component(list) see $index]
}

# ------------------------------------------------------------------
# PUBLIC METHOD: selection option first ?last?
#
# Adjusts the selection within the listbox and changes the contents
# of the entry component to be the value of the selected list item.
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::selection {option first {last {}}} {
    # thin wrap
    if {$option == "set"} {
	$itk_component(list) selection clear 0 end
	$itk_component(list) selection set $first
	set rtn ""
    } else {
	set rtn [eval $itk_component(list) selection $option $first $last]
    }
    set _currItem $first

    # combobox additions
    set theText [getcurselection]
    if {$theText != [$itk_component(entry) get]} {
	clear entry
	if {$theText != ""} {
	    insert entry 0 $theText
	}
    }
    return $rtn
}

# ------------------------------------------------------------------
# PUBLIC METHOD: size 
#
# Returns a decimal string indicating the total number of elements 
# in the listbox.
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::size {} {
    return [$itk_component(list) size]
}

# ------------------------------------------------------
# PUBLIC METHOD: sort ?mode?
#
# Sort the current list in either "ascending" or "descending" order.
#
#	jss: how should i handle selected items?
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::sort {{mode ascending}} {
    $itk_component(list) sort $mode
    #	 return [$itk_component(list) sort $mode]
}


# ------------------------------------------------------------------
# PUBLIC METHOD: xview ?arg arg ...?
#
# Change or query the vertical position of the text in the list box.
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::xview {args} {
    return [eval $itk_component(list) xview $args]
}

# ------------------------------------------------------------------
# PUBLIC METHOD: yview ?arg arg ...?
#
# Change or query the horizontal position of the text in the list box.
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::yview {args} {
    return [eval $itk_component(list) yview $args]
}

# ------------------------------------------------------
# PROTECTED METHOD: _addToList
#
# Add the current item in the entry to the listbox.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_addToList {} {
    set input [get]
    if {$input != ""} {
	if {$itk_option(-unique)} {
	    # if item is already in list, select it and exit
	    set item [lsearch -exact [$itk_component(list) get 0 end] $input]
	    if {$item != -1} {
		selection clear 0 end
		if {$item != {}} {
		    selection set $item $item
		    set _currItem $item
		}
		return
	    }
	}
	# add the item to end of list
	selection clear 0 end
	insert list end $input
	selection set end end
    }
}

# ------------------------------------------------------
# PROTECTED METHOD:	  _createComponents
#
# Create deferred combobox components and add bindings.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_createComponents {} {
    if {$itk_option(-dropdown)} {
	# --- build a dropdown combobox ---

	# make the arrow childsite be on the right hand side

  	#-------------------------------------------------------------
	# BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/4/99
  	#-------------------------------------------------------------
	# The following commented line of code overwrites the -command
	# option when passed into the constructor.  The order of calls
	# in the constructor is:
	# 	1) eval itk_initalize $args (initializes -command)
	#       2) _doLayout
	#       3) _createComponents (overwrites -command)
	# The solution is to only set the -command option if it hasn't
	# already been set.  The following 4 lines of code do this.
  	#-------------------------------------------------------------
	# ** configure -childsitepos e -command [code $this _addToList]
  	#-------------------------------------------------------------
	configure -childsitepos e
	if ![llength [cget -command]] {
	  configure -command [itcl::code $this _addToList]
	}
	
	# arrow button to popup the list
	itk_component add arrowBtn {
	    button $itk_interior.arrowBtn -borderwidth 2 \
		-width 15 -height 15 -image downarrow \
		-command [itcl::code $this _toggleList] -state $itk_option(-state)
	} {
	    keep -background -borderwidth -cursor  -state \
		-highlightcolor -highlightthickness
	    rename -relief -arrowrelief arrowRelief Relief
	    rename -highlightbackground -background background Background
	}
	
	# popup list container
	itk_component add popup {
	    toplevel $itk_interior.popup
	} {
	    keep -background -cursor
	}
	wm withdraw $itk_interior.popup
	
	# the listbox
	itk_component add list {
	    iwidgets::Scrolledlistbox $itk_interior.popup.list -exportselection no \
		-vscrollmode dynamic -hscrollmode dynamic -selectmode browse
	} {
	    keep -background -borderwidth -cursor -foreground \
		-highlightcolor -highlightthickness \
		-hscrollmode -selectbackground \
		-selectborderwidth -selectforeground -textbackground \
		-textfont -vscrollmode
	    rename -height -listheight listHeight Height
	    rename -cursor -popupcursor popupCursor Cursor
	}
	# mode specific bindings
	_dropdownBindings

	# Ugly hack to avoid tk buglet revealed in _dropdownBtnRelease where 
	# relief is used but not set in scrollbar.tcl. 
	global tkPriv
	set tkPriv(relief) raise

    } else {
	# --- build a simple combobox ---
	configure -childsitepos s
	itk_component add list {
	    iwidgets::Scrolledlistbox $itk_interior.list -exportselection no \
		-vscrollmode dynamic -hscrollmode dynamic 
	} {
	    keep -background -borderwidth -cursor -foreground \
		-highlightcolor -highlightthickness \
		-hscrollmode -selectbackground \
		-selectborderwidth -selectforeground -textbackground \
		-textfont -visibleitems -vscrollmode 
	    rename -height -listheight listHeight Height
	}
	# add mode specific bindings
	_simpleBindings
    }

    # popup cursor applies only to the list within the combobox
    configure -popupcursor $itk_option(-popupcursor)

    # add mode independent bindings
    _commonBindings
}

# ------------------------------------------------------
# PROTECTED METHOD: _deleteList first ?last?
#
# Delete an item or items from the listbox. Called via 
# "delete list args".
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_deleteList {first {last {}}} {

    if {$last == {}} {
	set last $first
    }
    $itk_component(list) delete $first $last

    # remove the item if it is no longer in the list
    set text [$this get]
    if {$text != ""} {
	set index [lsearch -exact [$itk_component(list) get 0 end] $text ]
	if {$index == -1} {
	    clear entry
	}
    }
    return
}

# ------------------------------------------------------
# PROTECTED METHOD: _deleteText first ?last?
#
# Renamed Entryfield delete method. Called via "delete entry args".
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_deleteText {first {last {}}} {
    $itk_component(entry) configure -state normal 
    set rtrn [delete $first $last]
    switch -- $itk_option(-editable) {
	0 - false - no - off {
	    $itk_component(entry) configure -state readonly
	}
    }
    return $rtrn
}

# ------------------------------------------------------
# PROTECTED METHOD:	  _doLayout ?when?
#
# Call methods to create and pack the Combobox components.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_doLayout {{when later}} {
    _createComponents
    _packComponents $when
}


# ------------------------------------------------------
# PROTECTED METHOD:	  _drawArrow 
#
# Draw the arrow button. Determines packing according to
# -labelpos.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_drawArrow {} {
    set flip false
    set relief ""
    set fg [cget -foreground]
    if {$_isPosted} {
	set flip true
	set relief "-relief sunken"
    } else {
	set relief "-relief $itk_option(-arrowrelief)"
    }

    if {$flip} {
	#	 
	#				draw up arrow
	#
	eval $itk_component(arrowBtn) configure -image uparrow $relief
    } else {
	#	 
	#				draw down arrow
	#
	eval $itk_component(arrowBtn) configure -image downarrow $relief
    }
}

# ------------------------------------------------------
# PROTECTED METHOD: _dropdownBtnRelease window x y
#
# Event handler for button releases while a dropdown list
# is posted.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_dropdownBtnRelease {{window {}} {x 1} {y 1}} {

    # if it's a scrollbar then ignore the release
    if {($window == [$itk_component(list) component vertsb]) ||
	($window == [$itk_component(list) component horizsb])} {
	return
    }

    # 1st release allows list to stay up unless we are in listbox
    if {$_ignoreRelease} {
	_ignoreNextBtnRelease false
	return
    }
    
    # should I use just the listbox or also include the scrollbars
    if { ($x >= 0) && ($x < [winfo width [_slbListbox]])
	 && ($y >= 0) && ($y < [winfo height [_slbListbox]])} {
	_stateSelect
    }
    
    _unpostList

    # execute user command
    if {$itk_option(-selectioncommand) != ""} {
	uplevel #0 $itk_option(-selectioncommand)
    }
}

# ------------------------------------------------------
# PROTECTED METHOD: _ignoreNextBtnRelease ignore
#
# Set private variable _ignoreRelease. If this variable
# is true then the next button release will not remove
# a dropdown list.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_ignoreNextBtnRelease {ignore} {
    set _ignoreRelease $ignore
}

# ------------------------------------------------------
# PROTECTED METHOD:	  _next
#
# Select the next item in the list.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_next {} {

    set _next_prevFLAG 1

    if {[size] <= 1} {
	return
    }
    set i [curselection]
    if {($i == {}) || ($i == ([size]-1)) } {
	set i 0
    } else {
	incr i
    }
    selection clear 0 end
    selection set $i $i
    see $i
    set _currItem $i
}

# ------------------------------------------------------
# PROTECTED METHOD:	  _packComponents ?when?
#
# Pack the components of the combobox and add bindings.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_packComponents {{when later}} {
    if {$when == "later"} {
	if {$_repacking == ""} {
	    set _repacking [after idle [itcl::code $this _packComponents now]]
	    return
	}
    } elseif {$when != "now"} {
	error "bad option \"$when\": should be now or later"
    }

    if {$itk_option(-dropdown)} {
	grid configure $itk_component(list) -row 1 -column 0 -sticky news
	_resizeArrow
        grid config $itk_component(arrowBtn) -row 0 -column 1 -sticky nsew
    } else {
	# size and pack list hack
	grid configure $itk_component(entry) -row 0 -column 0 -sticky ew
	grid configure $itk_component(efchildsite) -row 1 -column 0 -sticky nsew
	grid configure $itk_component(list) -row 0 -column 0 -sticky nsew

	grid rowconfigure $itk_component(efchildsite) 1 -weight 1
	grid columnconfigure $itk_component(efchildsite) 0 -weight 1
    }
    set _repacking ""
}

# ------------------------------------------------------
# PROTECTED METHOD:	  _positionList
#
# Determine the position (geometry) for the popped up list
# and map it to the screen.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_positionList {} {

    set x [winfo rootx $itk_component(entry) ]
    set y [expr {[winfo rooty $itk_component(entry) ] + \
	       [winfo height $itk_component(entry) ]}]
    set w [winfo width $itk_component(entry) ]
    set h [winfo height [_slbListbox] ]
    set sh [winfo screenheight .]

    if {(($y+$h) > $sh) && ($y > ($sh/2))} {
	set y [expr {[winfo rooty $itk_component(entry) ] - $h}]
    }
    
    $itk_component(list) configure -width $w
    wm overrideredirect $itk_component(popup) 0
    wm geometry $itk_component(popup) +$x+$y
    wm overrideredirect $itk_component(popup) 1
}

# ------------------------------------------------------
# PROTECTED METHOD:	  _postList
#
# Pop up the list in a dropdown style Combobox.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_postList {} {
    if {[$itk_component(list) size] == ""} {
	return
    }

    set _isPosted true
    _positionList

    # map window and do a grab
    wm deiconify $itk_component(popup)
    _listShowing -wait

    # Added by csmith, 12/19/00.  Thanks to Erik Leunissen for
    # finding this problem.  We need to restore any previous
    # grabs after the dropdown listbox is withdrawn.  To do this,
    # save the currently grabbed window.  It is then restored in
    # the _unpostList method.
    set _grab(window) [::grab current]
    if {$_grab(window) != ""} {
      set _grab(status) [::grab status $_grab(window)]
    }

    # Now grab the dropdown listbox.
    if {$itk_option(-grab) == "global"} {
	::grab -global $itk_component(popup) 
    } else {
	::grab $itk_component(popup) 
    }
    raise $itk_component(popup)
    focus $itk_component(popup)
    _drawArrow

    # Added by csmith, 10/26/00.  This binding keeps the listbox
    # from staying mapped if the window in which the combobox
    # is packed is iconified.
    bind $itk_component(entry) <Unmap> [itcl::code $this _unpostList]
}

# ------------------------------------------------------
# PROTECTED METHOD:	   _previous
#
# Select the previous item in the list. Wraps at front
# and end of list. 
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_previous {} {

    set _next_prevFLAG 1

    if {[size] <= 1} {
	return
    }
    set i [curselection]
    if {$i == "" || $i == 0} {
	set i [expr {[size] - 1}]
    } else {
	incr i -1
    }
    selection clear 0 end
    selection set $i $i
    see $i
    set _currItem $i
}

# ------------------------------------------------------
# PROTECTED METHOD:	  _resizeArrow
#
# Recalculate the arrow button size and then redraw it.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_resizeArrow {} {
    set bw [expr {[$itk_component(arrowBtn) cget -borderwidth]+ \
		[$itk_component(arrowBtn) cget -highlightthickness]}]
    set newHeight [expr {[winfo reqheight $itk_component(entry)]-(2*$bw) - 2}]
    $itk_component(arrowBtn) configure -width $newHeight -height $newHeight
    _drawArrow
}

# ------------------------------------------------------
# PROTECTED METHOD:	  _selectCmd
#
# Called when list item is selected to insert new text 
# in entry, and call user -command callback if defined.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_selectCmd {} {
    $itk_component(entry) configure -state normal
    
    set _currItem [$itk_component(list) curselection]
    set item [$itk_component(list) getcurselection]
    clear entry
    $itk_component(entry) insert 0 $item
    switch -- $itk_option(-editable) {
	0 - false - no - off {
	    $itk_component(entry) configure -state readonly
	}
    }
}

# ------------------------------------------------------
# PROTECTED METHOD:	 _toggleList
#
# Post or unpost the dropdown listbox (toggle).
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_toggleList {} {
    if {[winfo ismapped $itk_component(popup)] } {
	_unpostList
    } else {
	_postList
    }
}

# ------------------------------------------------------
# PROTECTED METHOD:	  _unpostList
#
# Unmap the listbox (pop it down).
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_unpostList {} {
    # Determine if event occured in the scrolledlistbox and, if it did, 
    # don't unpost it. (A selection in the list unposts it correctly and 
    # in the scrollbar we don't want to unpost it.)
    set x [winfo x $itk_component(list)]
    set y [winfo y $itk_component(list)]
    set w [winfo width $itk_component(list)]
    set h [winfo height $itk_component(list)]

    wm withdraw $itk_component(popup)
    ::grab release $itk_component(popup)	

    # Added by csmith, 12/19/00.  Thanks to Erik Leunissen for finding
    # this problem.  We need to restore any previous grabs when the
    # dropdown listbox is unmapped.
    if {$_grab(window) != ""} {
      if {$_grab(status) == "global"} {
        ::grab -global $_grab(window)
      } else {
	::grab $_grab(window)
      }
      set _grab(window) ""
      set _grab(status) ""
    }

    # Added by csmith, 10/26/00.  This binding resets the binding
    # created in _postList - see that method for further details.
    bind $itk_component(entry) <Unmap> {}
    
    set _isPosted false
    
    $itk_component(list) selection clear 0 end
    if {$_currItem != {}} {
	$itk_component(list) selection set $_currItem $_currItem
	$itk_component(list) activate $_currItem
    }

    switch -- $itk_option(-editable) {
	1 - true - yes - on {
	    $itk_component(entry) configure -state normal
	}
	0 - false - no - off {
	    $itk_component(entry) configure -state readonly
	}
    }

    _drawArrow
    update
}

# ------------------------------------------------------
# PROTECTED METHOD:	  _commonBindings
#
# Bindings that are used by both simple and dropdown
# style Comboboxes.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_commonBindings {} {
    bind $itk_component(entry) <KeyPress-BackSpace> [itcl::code $this _bs]
    bind $itk_component(entry) <KeyRelease> [itcl::code $this _lookup %K]
    bind $itk_component(entry) <Down>       [itcl::code $this _next]
    bind $itk_component(entry) <Up>         [itcl::code $this _previous]
    bind $itk_component(entry) <Control-n>  [itcl::code $this _next]
    bind $itk_component(entry) <Control-p>  [itcl::code $this _previous]
    bind [_slbListbox]         <Control-n>  [itcl::code $this _next]
    bind [_slbListbox]         <Control-p>  [itcl::code $this _previous]
}


# ------------------------------------------------------
# PROTECTED METHOD: _dropdownBindings
#
# Bindings used only by the dropdown type Combobox.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_dropdownBindings {} {
    bind $itk_component(popup)  <Escape> [itcl::code $this _unpostList]
    bind $itk_component(popup)  <space>  \
	"[itcl::code $this _stateSelect]; [itcl::code $this _unpostList]"
    bind $itk_component(popup)  <Return> \
	"[itcl::code $this _stateSelect]; [itcl::code $this _unpostList]"
    bind $itk_component(popup)  <ButtonRelease-1> \
        [itcl::code $this _dropdownBtnRelease %W %x %y]

    bind $itk_component(list)  <Map> \
	[itcl::code $this _listShowing 1]
    bind $itk_component(list)  <Unmap> \
        [itcl::code $this _listShowing 0]

    # once in the listbox, we drop on the next release (unless in scrollbar)
    bind [_slbListbox]   <Enter>   \
	[itcl::code $this _ignoreNextBtnRelease false]

    bind $itk_component(arrowBtn) <3>          [itcl::code $this _next]
    bind $itk_component(arrowBtn) <Shift-3>    [itcl::code $this _previous]
    bind $itk_component(arrowBtn) <Down>       [itcl::code $this _next]
    bind $itk_component(arrowBtn) <Up>         [itcl::code $this _previous]
    bind $itk_component(arrowBtn) <Control-n>  [itcl::code $this _next]
    bind $itk_component(arrowBtn) <Control-p>  [itcl::code $this _previous]
    bind $itk_component(arrowBtn) <Shift-Down> [itcl::code $this _toggleList]
    bind $itk_component(arrowBtn) <Shift-Up>   [itcl::code $this _toggleList]
    bind $itk_component(arrowBtn) <Return>     [itcl::code $this _toggleList]
    bind $itk_component(arrowBtn) <space>      [itcl::code $this _toggleList]

    bind $itk_component(entry)    <Configure>  [itcl::code $this _resizeArrow]
    bind $itk_component(entry)    <Shift-Down> [itcl::code $this _toggleList]
    bind $itk_component(entry)    <Shift-Up>   [itcl::code $this _toggleList]
}

# ------------------------------------------------------
# PROTECTED METHOD: _simpleBindings
#
# Bindings used only by the simple type Comboboxes.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_simpleBindings {} {
    bind [_slbListbox]         <ButtonRelease-1> [itcl::code $this _stateSelect]
    bind [_slbListbox]         <space>     [itcl::code $this _stateSelect]
    bind [_slbListbox]         <Return>    [itcl::code $this _stateSelect]
    bind $itk_component(entry) <Escape>     ""
    bind $itk_component(entry) <Shift-Down> ""
    bind $itk_component(entry) <Shift-Up>   ""
    bind $itk_component(entry) <Configure>  ""
}

# ------------------------------------------------------
# PROTECTED METHOD: _listShowing ?val?
#
# Used instead of "tkwait visibility" to make sure that
# the dropdown list is visible.	 Whenever the list gets
# mapped or unmapped, this method is called to keep
# track of it.	When it is called with the value "-wait",
# it waits for the list to be mapped.
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_listShowing {{val ""}} {
    if {$val == ""} {
	return $_listShowing($this)
    } elseif {$val == "-wait"} {
	while {!$_listShowing($this)} {
	    tkwait variable [itcl::scope _listShowing($this)]
	}
	return
    }
    set _listShowing($this) $val
}

# ------------------------------------------------------
# PRIVATE METHOD:	 _slbListbox
#
# Access the tk listbox window out of the scrolledlistbox.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_slbListbox {} {
    return [$itk_component(list) component listbox]
}

# ------------------------------------------------------
# PRIVATE METHOD:	 _stateSelect
#
# only allows a B1 release in the listbox to have an effect if -state is
#	normal.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_stateSelect {} {
    switch --  $itk_option(-state) {
	normal {
	    [itcl::code $this _selectCmd]
	}
    }
}

# ------------------------------------------------------
# PRIVATE METHOD:	 _bs
#
# A part of the auto-completion code, this function sets a flag when the
#	Backspace key is hit and there is a selection in the entry field.
# Note that it's probably buggy to assume that a selection being present
#	means that that selection came from auto-completion.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_bs {} {
    #
    #		exit if completion is turned off
    #
    switch -- $itk_option(-completion) {
	0 - no - false - off {
	    return
	}
    }
    #
    #		critical section flag.  it ain't perfect, but for most usage it'll
    #		keep us from being in this code "twice" at the same time
    #		(auto-repeated keystrokes are a pain!)
    #
    if {$_inbs} {
	return
    } else {
	set _inbs 1
    }

    #
    #		set the _doit flag if there is a selection set in the entry field
    #
    set _doit 0
    if [$itk_component(entry) selection present] {
	set _doit 1
    }

    #
    #		clear the semaphore and return
    #
    set _inbs 0
}

# ------------------------------------------------------
# PRIVATE METHOD:	 _lookup
#
# handles auto-completion of text typed (or insert'd) into the entry field.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_lookup {key} {

    #
    # Don't process auto-completion stuff if navigation key was released
    # Fixes SF bug 501300
    #
    if {$_next_prevFLAG} {
        set _next_prevFLAG 0
        return
    }

    #
    #		exit if completion is turned off
    #
    switch -- $itk_option(-completion) {
	0 - no - false - off {
	    return
	}
    }

    #
    #		critical section flag.  it ain't perfect, but for most usage it'll
    #		keep us from being in this code "twice" at the same time
    #		(auto-repeated keystrokes are a pain!)
    #
    if {$_inlookup} {
	return
    } else {
	set _inlookup 1
    }

    #
    #		if state of megawidget is disabled, or the entry is not editable,
    #		clear the semaphore and exit
    #
    if {$itk_option(-state) == "disabled" \
	    || [lsearch {on 1 true yes} $itk_option(-editable)] == -1} {
	set _inlookup 0
	return
    }

    #
    #		okay, *now* we can get to work
    #		the _bs function is called on keyPRESS of BackSpace, and will set
    #		the _doit flag if there's a selection set in the entryfield.  If
    #		there is, we're assuming that it's generated by completion itself
    #		(this is probably a Bad Assumption), so we'll want to whack the
    #		selected text, as well as the character immediately preceding the
    #		insertion cursor.
    #
    if {$key == "BackSpace"} {
	if {$_doit} {
	    set first [expr {[$itk_component(entry) index insert] -1}]
	    $itk_component(entry) delete $first end
	    $itk_component(entry) icursor $first
	}
    }

    #
    #		get the text left in the entry field, and its length.  if
    #		zero-length, clear the selection in the listbox, clear the
    #		semaphore, and boogie.
    #
    set text [get]
    set len [string length $text]
    if {$len == 0} {
	$itk_component(list) selection clear 0 end
	set _inlookup 0
	return
    }

    # No need to do lookups for Shift keys or Arrows.  The up/down
    # arrow keys should walk up/down the listbox entries.
    switch $key {
      Shift_L - Shift_R - Up - Down - Left - Right {
        set _inlookup 0
        return
      }
      default { }
    }

    # Added by csmith 12/11/01 to resolve SF ticket #474817.  It's an unusual
    # circumstance, but we need to make sure the character passed into this
    # method matches the last character in the entry's text string.  It's
    # possible to type fast enough that the _lookup method gets invoked
    # *after* multiple characters have been typed and *before* the first
    # character has been processed.  For example, you can type "bl" very
    # quickly, and by the time the interpreter processes "b", the "l" has
    # already been placed in the entry field.  This causes problems as noted
    # in the SF ticket.
    #
    # Thus, if the character currently being processed does not match the
    # last character in the entry field, reset the _inlookup flag and return.
    # Also, note that we're only concerned with single characters here, not
    # keys such as backspace, delete, etc.
    if {$key != [string range $text end end] && [string match ? $key]} {
      set _inlookup 0
      return
    }

    #
    #		okay, so we have to do a lookup.  find the first match in the
    #		listbox to the text we've got in the entry field (glob).
    #		if one exists, clear the current listbox selection, and set it to
    #		the one we just found, making that one visible in the listbox.
    #		then, pick off the text from the listbox entry that hadn't yet been
    #		entered into the entry field.  we need to tack that text onto the
    #		end of the entry field, select it, and then set the insertion cursor
    #		back to just before the point where we just added that text.
    #		if one didn't exist, then just clear the listbox selection
    #
    set item [lsearch [$itk_component(list) get 0 end] "$text*" ]
    if {$item != -1} {
	$itk_component(list) selection clear 0 end
	$itk_component(list) selection set $item $item
	see $item
	set remainder [string range [$itk_component(list) get $item] $len end]
	$itk_component(entry) insert end $remainder
	$itk_component(entry) selection range $len end
	$itk_component(entry) icursor $len
    } else {
	$itk_component(list) selection clear 0 end
    }
    #
    #		clear the semaphore and return
    #
    set _inlookup 0
    return
}

 	  	 

Added library/dateentry.itk.

















































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
#
# Dateentry
# ----------------------------------------------------------------------
# Implements a quicken style date entry field with a popup calendar
# by combining the datefield and calendar widgets together.  This
# allows a user to enter the date via the keyboard or by using the
# mouse by selecting the calendar icon which brings up a popup calendar.
# ----------------------------------------------------------------------
#   AUTHOR:  Mark L. Ulferts          E-mail: mulferts@austin.dsccc.com
#
#   @(#) $Id: dateentry.itk,v 1.7 2003/01/30 20:56:05 smithc Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1997 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================
#
# ----------------------------------------------------------------------
#
# Modified 2001-10-23 by Mark Alston to pass options to the datefield 
# constructor.  Needed to allow use of new option -int which lets the 
# user use dates in YYYY-MM-DD format as well as MM/DD/YYYY format.
#
# option -int yes sets dates to YYYY-MM-DD format
#        -int no sets dates to MM/DD/YYYY format.
#
# ----------------------------------------------------------------------
#
# Usual options.
#
itk::usual Dateentry {
    keep -background -borderwidth -currentdatefont -cursor \
	-datefont -dayfont -foreground -highlightcolor \
	-highlightthickness -labelfont -textbackground -textfont \
	-titlefont -int
}

# ------------------------------------------------------------------
#                              DATEENTRY
# ------------------------------------------------------------------
itcl::class iwidgets::Dateentry {
    inherit iwidgets::Datefield

    constructor {args} {
	eval Datefield::constructor $args
    } {}

    itk_option define -grab grab Grab "global"
    itk_option define -icon icon Icon {}
    
    #
    # The calendar widget isn't created until needed, yet we need
    # its options to be available upon creation of a dateentry widget.
    # So, we'll define them in these class now so they can just be
    # propagated onto the calendar later.
    #
    itk_option define -days days Days {Su Mo Tu We Th Fr Sa}
    itk_option define -forwardimage forwardImage Image {}
    itk_option define -backwardimage backwardImage Image {}
    itk_option define -weekdaybackground weekdayBackground Background \#d9d9d9
    itk_option define -weekendbackground weekendBackground Background \#d9d9d9
    itk_option define -outline outline Outline \#d9d9d9
    itk_option define -buttonforeground buttonForeground Foreground blue
    itk_option define -foreground foreground Foreground black
    itk_option define -selectcolor selectColor Foreground red
    itk_option define -selectthickness selectThickness SelectThickness 3
    itk_option define -titlefont titleFont Font \
	-*-helvetica-bold-r-normal--*-140-*
    itk_option define -dayfont dayFont Font \
	-*-helvetica-medium-r-normal--*-120-*
    itk_option define -datefont dateFont Font \
	-*-helvetica-medium-r-normal--*-120-*
    itk_option define -currentdatefont currentDateFont Font \
	-*-helvetica-bold-r-normal--*-120-*
    itk_option define -startday startDay Day sunday
    itk_option define -height height Height 165
    itk_option define -width width Width 200
    itk_option define -state state State normal

    protected {
	method _getPopupDate {date}
	method _releaseGrab {}
	method _releaseGrabCheck {rootx rooty}
	method _popup {}
	method _getDefaultIcon {}

        common _defaultIcon ""
    }
}

#
# Provide a lowercased access method for the dateentry class.
# 
proc ::iwidgets::dateentry {pathName args} {
    uplevel ::iwidgets::Dateentry $pathName $args
}

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Dateentry::constructor {args} {
    #
    # Create an icon label to act as a button to bring up the 
    # calendar popup.
    #
    itk_component add iconbutton {
	label $itk_interior.iconbutton -relief raised
    } {
	keep -borderwidth -cursor -foreground 
    }
    grid $itk_component(iconbutton) -row 0 -column 0 -sticky ns
    
    #
    # Initialize the widget based on the command line options.
    #
    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -icon
#
# Specifies the calendar icon image to be used in the date.
# Should one not be provided, then a default pixmap will be used
# if possible, bitmap otherwise.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Dateentry::icon {
    if {$itk_option(-icon) == {}} {
	$itk_component(iconbutton) configure -image [_getDefaultIcon]
    } else {
	if {[lsearch [image names] $itk_option(-icon)] == -1} {
	    error "bad icon option \"$itk_option(-icon)\":\
                   should be an existing image"
	} else {
	    $itk_component(iconbutton) configure -image $itk_option(-icon)
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -grab
#
# Specifies the grab level, local or global, to be obtained when 
# bringing up the popup calendar.  The default is global.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Dateentry::grab {
    switch -- $itk_option(-grab) {
	"local" - "global" {}
	default {
	    error "bad grab option \"$itk_option(-grab)\":\
                   should be local or global"
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -state
#
# Specifies the state of the widget which may be disabled or
# normal.  A disabled state prevents selection of the date field
# or date icon button.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Dateentry::state {
    switch -- $itk_option(-state) {
	normal {
	    bind $itk_component(iconbutton) <Button-1> [itcl::code $this _popup]
	}
	disabled {
	    bind $itk_component(iconbutton) <Button-1> {}
	}
    }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# PROTECTED METHOD: _getDefaultIcon
#
# This method is invoked uto retrieve the name of the default icon
# image displayed in the icon button.
# ------------------------------------------------------------------
itcl::body iwidgets::Dateentry::_getDefaultIcon {} {
    if {[lsearch [image types] pixmap] != -1} {
      set _defaultIcon [image create pixmap -data {
	  /* XPM */
	  static char *calendar[] = {
	  /* width height num_colors chars_per_pixel */
	  "    25    20        6            1",
	  /* colors */
	  ". c #808080",
	  "# c #040404",
	  "a c #848484",
	  "b c #fc0404",
	  "c c #fcfcfc",
	  "d c #c0c0c0",
	  /* pixels */
	  "d##########d###########dd",
	  "d#ccccccccc##ccccccccca#d",
	  "##ccccccccc.#ccccccccc..#",
	  "##cccbbcccca#cccbbbccca.#",
	  "##cccbbcccc.#ccbbbbbcc..#",
	  "##cccbbccc####ccccbbcc..#",
	  "##cccbbcccca#ccccbbbcca.#",
	  "##cccbbcccc.#cccbbbccc..#",
	  "##cccbbcccca#ccbbbcccca.#",
	  "##cccbbbccc.#ccbbbbbcc..#",
	  "##ccccccccc.#ccccccccc..#",
	  "##ccccccccca#ccccccccca.#",
	  "##cc#####c#cd#c#####cc..#",
	  "##cccccccc####cccccccca.#",
	  "##cc#####cc.#cc#####cc..#",
	  "##ccccccccc.#ccccccccc..#",
	  "##ccccccccc.#ccccccccc..#",
	  "##..........#...........#",
	  "###..........#..........#",
	  "#########################"
	 };
	}]
    } else {
	set _defaultIcon [image create bitmap -data {
	    #define calendr2_width 25
	    #define calendr2_height 20
	    static char calendr2_bits[] = {
		0xfe,0xf7,0x7f,0xfe,0x02,0x18,0xc0,0xfe,0x03,
		0x18,0x80,0xff,0x63,0x10,0x47,0xff,0x43,0x98,
		0x8a,0xff,0x63,0x3c,0x4c,0xff,0x43,0x10,0x8a,
		0xff,0x63,0x18,0x47,0xff,0x23,0x90,0x81,0xff,
		0xe3,0x98,0x4e,0xff,0x03,0x10,0x80,0xff,0x03,
		0x10,0x40,0xff,0xf3,0xa5,0x8f,0xff,0x03,0x3c,
		0x40,0xff,0xf3,0x99,0x8f,0xff,0x03,0x10,0x40,
		0xff,0x03,0x18,0x80,0xff,0x57,0x55,0x55,0xff,
		0x57,0xb5,0xaa,0xff,0xff,0xff,0xff,0xff};
        }]
    }

    #
    # Since this image will only need to be created once, we redefine
    # this method to just return the image name for subsequent calls.
    #
    itcl::body ::iwidgets::Dateentry::_getDefaultIcon {} {
	return $_defaultIcon
    }

    return $_defaultIcon
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _popup
#
# This method is invoked upon selection of the icon button.  It 
# creates a calendar widget within a toplevel popup, calculates 
# the position at which to display the calendar, performs a grab
# and displays the calendar.
# ------------------------------------------------------------------
itcl::body iwidgets::Dateentry::_popup {} {
    #
    # First, let's nullify the icon binding so that any another 
    # selections are ignored until were done with this one.  Next,
    # change the relief of the icon.
    #
    bind $itk_component(iconbutton) <Button-1> {}
    $itk_component(iconbutton) configure -relief sunken

    #
    # Create a withdrawn toplevel widget and remove the window 
    # decoration via override redirect.
    #
    itk_component add -private popup {
	toplevel $itk_interior.popup 
    } 
    $itk_component(popup) configure -borderwidth 2 -background black
    wm withdraw $itk_component(popup)
    wm overrideredirect $itk_component(popup) 1

    #
    # Add a binding to button 1 events in order to detect mouse
    # clicks off the calendar in which case we'll release the grab.
    # Also add a binding for Escape to always release.
    #
    bind $itk_component(popup) <1> [itcl::code $this _releaseGrabCheck %X %Y]
    bind $itk_component(popup) <KeyPress-Escape> [itcl::code $this _releaseGrab]

    #
    # Create the calendar widget and set its cursor properly.
    #
    itk_component add calendar {
	iwidgets::Calendar $itk_component(popup).calendar \
	    -command [itcl::code $this _getPopupDate %d] \
	    -int $itk_option(-int)
    } {
	usual
	keep -days -forwardimage -backwardimage -weekdaybackground \
	    -weekendbackground -outline -buttonforeground -selectcolor \
	    -selectthickness -titlefont -dayfont -datefont \
	    -currentdatefont -startday -width -height
    }
    grid $itk_component(calendar) -row 0 -column 0
    $itk_component(calendar) configure -cursor top_left_arrow

    #
    # The icon button will be used as the basis for the position of the
    # popup on the screen.  We'll always attempt to locate the popup
    # off the lower right corner of the button.  If that would put
    # the popup off the screen, then we'll put above the upper left.
    #
    set rootx [winfo rootx $itk_component(iconbutton)]
    set rooty [winfo rooty $itk_component(iconbutton)]
    set popupwidth [winfo reqwidth $itk_component(popup)]
    set popupheight [winfo reqheight $itk_component(popup)]

    set popupx [expr {$rootx + 3 + \
		    [winfo width $itk_component(iconbutton)]}]
    set popupy [expr {$rooty + 3 + \
		    [winfo height $itk_component(iconbutton)]}]

    if {(($popupx + $popupwidth) > [winfo screenwidth .]) || \
	    (($popupy + $popupheight) > [winfo screenheight .])} {
	set popupx [expr {$rootx - 3 - $popupwidth}]
	set popupy [expr {$rooty - 3 - $popupheight}]
    }
    
    #
    # Get the current date from the datefield widget and both
    # show and select it on the calendar.
    #
    # Added catch for bad dates. Calendar then shows current date.
    if [catch "$itk_component(calendar) show [get]" err] {
	$itk_component(calendar) show now
	$itk_component(calendar) select now
    } else {
	$itk_component(calendar) select [get]
    }
    #
    # Display the popup at the calculated position.
    #
    wm geometry $itk_component(popup) +$popupx+$popupy
    wm deiconify $itk_component(popup)
    tkwait visibility $itk_component(popup)

    #
    # Perform either a local or global grab based on the -grab option.
    #
    if {$itk_option(-grab) == "local"} {
	::grab $itk_component(popup)
    } else {
	::grab -global $itk_component(popup)
    }

    #
    # Make sure the widget is above all others and give it focus.
    #
    raise $itk_component(popup)
    focus $itk_component(calendar)
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _popupGetDate
#
# This method is the callback for selection of a date on the 
# calendar.  It releases the grab and sets the date in the
# datefield widget.
# ------------------------------------------------------------------
itcl::body iwidgets::Dateentry::_getPopupDate {date} {
    _releaseGrab 
    show $date
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _releaseGrabCheck rootx rooty
#
# This method handles mouse button 1 events.  If the selection
# occured within the bounds of the calendar, then return normally
# and let the calendar handle the event.  Otherwise, we'll drop
# the calendar and release the grab.
# ------------------------------------------------------------------
itcl::body iwidgets::Dateentry::_releaseGrabCheck {rootx rooty} {
    set calx [winfo rootx $itk_component(calendar)]
    set caly [winfo rooty $itk_component(calendar)]
    set calwidth [winfo reqwidth $itk_component(calendar)]
    set calheight [winfo reqheight $itk_component(calendar)]

    if {($rootx < $calx) || ($rootx > ($calx + $calwidth)) || \
	    ($rooty < $caly) || ($rooty > ($caly + $calheight))} {
	_releaseGrab
	return -code break
    }
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _releaseGrab
#
# This method releases the grab, destroys the popup, changes the 
# relief of the button back to raised and reapplies the binding
# to the icon button that engages the popup action.
# ------------------------------------------------------------------
itcl::body iwidgets::Dateentry::_releaseGrab {} {
    ::grab release $itk_component(popup)
    $itk_component(iconbutton) configure -relief raised
    destroy $itk_component(popup) 
    bind $itk_component(iconbutton) <Button-1> [itcl::code $this _popup]
}

Added library/datefield.itk.

























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
#
# Datefield
# ----------------------------------------------------------------------
# Implements a date entry field with adjustable built-in intelligence
# levels.
# ----------------------------------------------------------------------
#   AUTHOR:  Mark L. Ulferts          E-mail: mulferts@austin.dsccc.com
#
#   @(#) $Id: datefield.itk,v 1.6 2007/06/10 19:18:14 hobbs Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1997 DSC Technologies Corporation
# ======================================================================
#
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Datefield {
    keep -background -borderwidth -cursor -foreground -highlightcolor \
     -highlightthickness -labelfont -textbackground -textfont 
}

# ------------------------------------------------------------------
#                               DATEFIELD
# ------------------------------------------------------------------
itcl::class iwidgets::Datefield {
    inherit iwidgets::Labeledwidget 
    
    constructor {args} {}

    itk_option define -childsitepos childSitePos Position e
    itk_option define -command command Command {}
    itk_option define -iq iq Iq high
    itk_option define -gmt gmt GMT no
    itk_option define -int int DateFormat no
    
    public method get {{format "-string"}}
    public method isvalid {}
    public method show {{date now}}

    protected method _backward {}
    protected method _focusIn {}
    protected method _forward {}
    protected method _keyPress {char sym state}
    protected method _lastDay {month year}
    protected method _moveField {direction}
    protected method _setField {field}
    protected method _whichField {}

    protected variable _cfield "month"
    protected variable _fields {month day year}
}


#
# Provide a lowercased access method for the datefield class.
# 
proc ::iwidgets::datefield {pathName args} {
    uplevel ::iwidgets::Datefield $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *Datefield.justify center widgetDefault

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::constructor {args} {
    component hull configure -borderwidth 0
    
    #   
    # Create an entry field for entering the date.
    #   
    itk_component add date {
    entry $itk_interior.date -width 10
    } {
    keep -borderwidth -cursor -exportselection \
        -foreground -highlightcolor -highlightthickness \
        -insertbackground -justify -relief -state
    
    rename -font -textfont textFont Font
    rename -highlightbackground -background background Background
    rename -background -textbackground textBackground Background
    }

    #
    # Create the child site widget.
    #
    itk_component add -protected dfchildsite {
    frame $itk_interior.dfchildsite
    } 
    set itk_interior $itk_component(dfchildsite)
    
    #
    # Add datefield event bindings for focus in and keypress events.
    #
    bind $itk_component(date) <FocusIn> [itcl::code $this _focusIn]
    bind $itk_component(date) <KeyPress> [itcl::code $this _keyPress %A %K %s]
    
    #
    # Disable some mouse button event bindings:
    #   Button Motion
    #   Double-Clicks
    #   Triple-Clicks
    #   Button2
    #
    bind $itk_component(date) <Button1-Motion>  break
    bind $itk_component(date) <Button2-Motion>  break
    bind $itk_component(date) <Double-Button>   break
    bind $itk_component(date) <Triple-Button>   break
    bind $itk_component(date) <2>       break

    #
    # Initialize the widget based on the command line options.
    #
    eval itk_initialize $args

    #
    # Initialize the date to the current date.
    #
    $itk_component(date) delete 0 end

    show now
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -childsitepos
#
# Specifies the position of the child site in the widget.  Valid
# locations are n, s, e, and w.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Datefield::childsitepos {
    set parent [winfo parent $itk_component(date)]

    switch $itk_option(-childsitepos) {
    n {
        grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ew
        grid $itk_component(date) -row 1 -column 0 -sticky nsew

        grid rowconfigure $parent 0 -weight 0
        grid rowconfigure $parent 1 -weight 1
        grid columnconfigure $parent 0 -weight 1
        grid columnconfigure $parent 1 -weight 0
    }
    
    e {
        grid $itk_component(dfchildsite) -row 0 -column 1 -sticky ns
        grid $itk_component(date) -row 0 -column 0 -sticky nsew

        grid rowconfigure $parent 0 -weight 1
        grid rowconfigure $parent 1 -weight 0
        grid columnconfigure $parent 0 -weight 1
        grid columnconfigure $parent 1 -weight 0
    }
    
    s {
        grid $itk_component(dfchildsite) -row 1 -column 0 -sticky ew
        grid $itk_component(date) -row 0 -column 0 -sticky nsew

        grid rowconfigure $parent 0 -weight 1
        grid rowconfigure $parent 1 -weight 0
        grid columnconfigure $parent 0 -weight 1
        grid columnconfigure $parent 1 -weight 0
    }
    
    w {
        grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ns
        grid $itk_component(date) -row 0 -column 1 -sticky nsew

        grid rowconfigure $parent 0 -weight 1
        grid rowconfigure $parent 1 -weight 0
        grid columnconfigure $parent 0 -weight 0
        grid columnconfigure $parent 1 -weight 1
    }
    
    default {
        error "bad childsite option\
            \"$itk_option(-childsitepos)\":\
            should be n, e, s, or w"
    }
    }
}

# ------------------------------------------------------------------
# OPTION: -command
#
# Command invoked upon detection of return key press event.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Datefield::command {}

# ------------------------------------------------------------------
# OPTION: -iq
#
# Specifies the level of intelligence to be shown in the actions
# taken by the date field during the processing of keypress events.
# Valid settings include high, average, and low.  With a high iq,
# the date prevents the user from typing in an invalid date.  For 
# example, if the current date is 05/31/1997 and the user changes
# the month to 04, then the day will be instantly modified for them 
# to be 30.  In addition, leap years are fully taken into account.
# With average iq, the month is limited to the values of 01-12, but
# it is possible to type in an invalid day.  A setting of low iq
# instructs the widget to do no validity checking at all during
# date entry.  With both average and low iq levels, it is assumed
# that the validity will be determined at a later time using the
# date's isvalid command.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Datefield::iq {
    switch $itk_option(-iq) {
    high - average - low {
    }
    default {
        error "bad iq option \"$itk_option(-iq)\":\
                   should be high, average or low"
    }
    }
}

# ------------------------------------------------------------------
# OPTION: -int 
#
# Added by Mark Alston 2001/10/21
#
# Allows for the use of dates in "international" format: YYYY-MM-DD.
# It must be a boolean value.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Datefield::int { 
    switch $itk_option(-int) {
    1 - yes - true - on {
        set _cfield "year"
        set _fields {year month day}
    }
    0 - no - false - off { }
    default {
        error "bad int option \"$itk_option(-int)\": should be boolean"
    }
    }
    show [get]
}

# ------------------------------------------------------------------
# OPTION: -gmt
#
# This option is used for GMT time.  Must be a boolean value.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Datefield::gmt {
  switch $itk_option(-gmt) {
    0 - no - false - off { }
    1 - yes - true - on { }
    default {
      error "bad gmt option \"$itk_option(-gmt)\": should be boolean"
    }
  }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# PUBLIC METHOD: get ?format?
#
# Return the current contents of the datefield in one of two formats
# string or as an integer clock value using the -string and -clicks
# options respectively.  The default is by string.  Reference the 
# clock command for more information on obtaining dates and their 
# formats.
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::get {{format "-string"}} {
    set datestr [$itk_component(date) get]

    switch -- $format {
    "-string" {
        return $datestr
    }
    "-clicks" {
        return [clock scan $datestr]
    }
    default {
        error "bad format option \"$format\":\
                   should be -string or -clicks"
    }
    }
}

# ------------------------------------------------------------------
# PUBLIC METHOD: show date
#
# Changes the currently displayed date to be that of the date 
# argument.  The date may be specified either as a string or an
# integer clock value.  Reference the clock command for more 
# information on obtaining dates and their formats.
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::show {{date "now"}} {
    $itk_component(date) delete 0 end
    if {$itk_option(-int)} {
        set format {%Y-%m-%d}
    } else {
        set format {%m/%d/%Y}
    }

    if {$date == "now"} {
        set seconds [::clock seconds]
        $itk_component(date) insert end \
            [clock format $seconds -format "$format" -gmt $itk_option(-gmt)]

    } elseif { $itk_option(-iq) != "low" } {
        if {[catch {::clock format $date}] == 0} {
            set seconds $date
        } elseif {[catch {set seconds [::clock scan $date -gmt \
                $itk_option(-gmt)]}] != 0} {
            error "bad date: \"$date\", must be a valid date\
            string, clock clicks value or the keyword now"
        }
        $itk_component(date) insert end \
            [clock format $seconds -format "$format" -gmt $itk_option(-gmt)]
    } else {
        # Note that it doesn't matter what -int is set to.
        $itk_component(date) insert end $date
    }

    if {$itk_option(-int)} {
        _setField year
    } else {
        _setField month
    }

    return
}

# ------------------------------------------------------------------
# PUBLIC METHOD: isvalid
#
# Returns a boolean indication of the validity of the currently
# displayed date value.  For example, 3/3/1960 is valid whereas
# 02/29/1997 is invalid.
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::isvalid {} {
    if {[catch {clock scan [$itk_component(date) get]}] != 0} {
        return 0
    } else {
        return 1
    }
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _focusIn
#
# This method is bound to the <FocusIn> event.  It resets the 
# insert cursor and field settings to be back to their last known
# positions.
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::_focusIn {} {
    _setField $_cfield
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _keyPress 
#
# This method is the workhorse of the class.  It is bound to the
# <KeyPress> event and controls the processing of all key strokes.
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::_keyPress {char sym state} {
    #
    #  Determine which field we are in currently.  This is needed
    # since the user may have moved to this position via a mouse
    # selection and so it would not be in the position we last 
    # knew it to be.
    #
    _whichField 

    #
    # If we are using an international date the split char is "-" 
    # otherwise it is "/".
    #
    if {$itk_option(-int)} {
        set split_char "-"
    } else {
        set split_char "/"
    }


    #
    # Set up a few basic variables we'll be needing throughout the
    # rest of the method such as the position of the insert cursor
    # and the currently displayed day, month, and year.
    #
    set icursor [$itk_component(date) index insert]
    set splist [split [$itk_component(date) get] "$split_char"]


    # A bunch of added variables to allow for the use of int dates
    if {$itk_option(-int)} {
        set order {year month day}
        set year [lindex $splist 0]
        set month [lindex $splist 1]
        set day [lindex $splist 2]
        set year_start_pos 0
        set year_second_pos 1
        set year_third_pos 2
        set year_fourth_pos 3
        set year_end_pos 4
        set month_start_pos 5
        set month_second_pos 6
        set month_end_pos 7
        set day_start_pos 8
        set day_second_pos 9
        set day_end_pos 10
    } else {
        set order {month day year}
        set month [lindex $splist 0]
        set day [lindex $splist 1]
        set year [lindex $splist 2]
        set month_start_pos 0
        set month_second_pos 1
        set month_end_pos 2
        set day_start_pos 3
        set day_second_pos 4
        set day_end_pos 5
        set year_start_pos 6
        set year_second_pos 7
        set year_third_pos 8
        set year_fourth_pos 9
        set year_end_pos 10
    }


    #
    # Process numeric keystrokes.  This involes a fair amount of 
    # processing with step one being to check and make sure we
    # aren't attempting to insert more that 10 characters.  If
    # so ring the bell and break.
    #
    if {[string match {[0-9]} $char]} {
        if {[$itk_component(date) index insert] == 10} {
            bell
            return -code break
        }

        #
        # If we are currently in the month field then we process the
        # number entered based on the cursor position.  If we are at
        # at the first position and our iq is low, then accept any 
        # input.
        #
        if {$_cfield == "month"} {

            if {[$itk_component(date) index insert] == $month_start_pos} {
                if {$itk_option(-iq) == "low"} {
                $itk_component(date) delete $month_start_pos
                $itk_component(date) insert $month_start_pos $char
            } else {
                #
                # Otherwise, we're slightly smarter.  If the number
                # is less than two insert it at position zero.  If 
                # this makes the month greater than twelve, set the 
                # number at position one to zero which makes in 
                # effect puts the month back in range.  
                #
                regsub {([0-9])([0-9])} $month "$char\\2" month2b

                if {$char < 2} {
                    $itk_component(date) delete $month_start_pos
                    $itk_component(date) insert $month_start_pos $char

                    if {$month2b > 12} {
                        $itk_component(date) delete $month_second_pos
                        $itk_component(date) insert $month_second_pos 0
                        $itk_component(date) icursor $month_second_pos
                    } elseif {$month2b == "00"} {
                        $itk_component(date) delete $month_second_pos
                        $itk_component(date) insert $month_second_pos 1
                        $itk_component(date) icursor $month_second_pos
                    }

                    #
                    # Finally, if the number is greater than one we'll 
                    # assume that they really mean to be entering a zero
                    # followed by their number, do so for them, and 
                    # proceed to skip to the next field which is the 
                    # day field.
                    #
                } else {
                    $itk_component(date) delete $month_start_pos $month_end_pos
                    $itk_component(date) insert $month_start_pos 0$char
                    _setField day
                }
            }
            
            #
            # Else, we're at the second month position.  Again, if we aren't
            # too smart, let them enter anything.  Otherwise, if the 
            # number makes the month exceed twelve, set the month to
            # zero followed by their number to get it back into range.
            #
        } else {
            regsub {([0-9])([0-9])} $month "\\1$char" month2b
        
            if {$itk_option(-iq) == "low"} {
                $itk_component(date) delete $month_second_pos
                $itk_component(date) insert $month_second_pos $char
            } else {
                if {$month2b > 12} {
                    $itk_component(date) delete $month_start_pos $month_end_pos
                    $itk_component(date) insert $month_start_pos 0$char
                } elseif {$month2b == "00"} {
                    bell
                    return -code break
                } else {
                    $itk_component(date) delete $month_second_pos
                    $itk_component(date) insert $month_second_pos $char
                }           
            }
            _setField day
        }

        # 
        # Now, the month processing is complete and if we're of a
        # high level of intelligence, then we'll make sure that the
        # current value for the day is valid for this month.  If
        # it is beyond the last day for this month, change it to
        # be the last day of the new month.
        #
        if {$itk_option(-iq) == "high"} {
            set splist [split [$itk_component(date) get] "$split_char"]
            set month [lindex $splist [lsearch $order month]]
            if {$day > [set endday [_lastDay $month $year]]} {
                set icursor [$itk_component(date) index insert]
                $itk_component(date) delete $day_start_pos $day_end_pos
                $itk_component(date) insert $day_start_pos $endday
                $itk_component(date) icursor $icursor
            }
        }
        
        #
        # Finally, return with a code of break to stop any normal
        # processing in that we've done all that is necessary.
        #
        return -code break
    }

    #
    # This next block of code is for processing of the day field
    # which is quite similar is strategy to that of the month.
    #
    if {$_cfield == "day"} {
        if {$itk_option(-iq) == "high"} {
            set endofMonth [_lastDay $month $year]
        } else {
            set endofMonth 31
        }

        #
        # If we are at the first cursor position for the day 
        # we are processing 
        # the first character of the day field.  If we have an iq 
        # of low accept any input.
        #
        if {[$itk_component(date) index insert] == $day_start_pos} {
            if {$itk_option(-iq) == "low"} {
                $itk_component(date) delete $day_start_pos
                $itk_component(date) insert $day_start_pos $char
            
            } else {

                #
                # If the day to be is double zero, then make the
                # day be the first.
                #
                regsub {([0-9])([0-9])} $day "$char\\2" day2b

                if {$day2b == "00"} {
                    $itk_component(date) delete $day_start_pos $day_end_pos
                    $itk_component(date) insert $day_start_pos 01
                    $itk_component(date) icursor $day_second_pos
                    #
                    # Otherwise, if the character is less than four 
                    # and the month is not Feburary, insert the number 
                    # and if this makes the day be beyond the valid 
                    # range for this month, than set to be back in 
                    # range.  
                    #
                } elseif {($char < 4) && ($month != "02")} {
                    $itk_component(date) delete $day_start_pos
                    $itk_component(date) insert $day_start_pos $char
            
                    if {$day2b > $endofMonth} {
                        $itk_component(date) delete $day_second_pos
                        $itk_component(date) insert $day_second_pos 0
                        $itk_component(date) icursor $day_second_pos
                    } 
            
                    #
                    # For Feburary with a number to be entered of 
                    # less than three, make sure the number doesn't 
                    # make the day be greater than the correct range
                    # and if so adjust the input. 
                    #
                } elseif {$char < 3} {
                    $itk_component(date) delete $day_start_pos
                    $itk_component(date) insert $day_start_pos $char
                    if {$day2b > $endofMonth} {
                        $itk_component(date) delete $day_start_pos $day_end_pos
                        $itk_component(date) insert $day_start_pos $endofMonth
                        $itk_component(date) icursor $day_second_pos
                    } 

                    #
                    # Finally, if the number is greater than three,
                    # set the day to be zero followed by the number 
                    # entered and proceed to the year field or end.
                    #
                } else {
                    $itk_component(date) delete $day_start_pos $day_end_pos
                    $itk_component(date) insert $day_start_pos 0$char
                    $itk_component(date) icursor $day_end_pos
                    if {!$itk_option(-int)} {
                        _setField year
                    }
                }
            }
            #
            # Else, we're dealing with the second number in the day
            # field.  If we're not too bright accept anything, otherwise
            # if the day is beyond the range for this month or equal to
            # zero then ring the bell.
            #
        } else {
            regsub {([0-9])([0-9])} $day "\\1$char" day2b
        
            if {($itk_option(-iq) != "low") && \
                (($day2b > $endofMonth) || ($day2b == "00"))} {
                bell
            } else {
                $itk_component(date) delete $day_second_pos
                $itk_component(date) insert $day_second_pos $char
                $itk_component(date) icursor $day_end_pos
                if {!$itk_option(-int)} {
                    _setField year
                }
            }
        }

        #
        # Return with a code of break to prevent normal processing. 
        #
        return -code break
    }

    #
    # This month and day we're tough, the code for the year is 
    # comparitively simple.  Accept any input and if we are really
    # sharp, then make sure the day is correct for the month
    # given the year.  In short, handle leap years.
    #
    if {$_cfield == "year"} {
        if {$itk_option(-iq) == "low"} {
            $itk_component(date) delete $icursor
            $itk_component(date) insert $icursor $char
        } else {
            set prevdate [get]
            if {[$itk_component(date) index insert] == $year_start_pos} {
                set yrdgt [lindex [split [lindex \
                [split $prevdate "$split_char"] [lsearch $order year]] ""] 0]
                if {$char != $yrdgt} {
                    if {$char == 1} {
                        $itk_component(date) delete $icursor $year_end_pos
                        $itk_component(date) insert $icursor 1999
                    } elseif {$char == 2} {
                        $itk_component(date) delete $icursor $year_end_pos
                        $itk_component(date) insert $icursor 2000
                    } else {
                        bell
                        return -code break
                    }
                }

                $itk_component(date) icursor $year_second_pos
                return -code break
            }
        
            $itk_component(date) delete $icursor
            $itk_component(date) insert $icursor $char


            if {[catch {clock scan [get]}] != 0} {
                $itk_component(date) delete $year_start_pos $year_end_pos
                $itk_component(date) insert $year_start_pos \
                [lindex [split $prevdate "$split_char"] [lsearch $order year]]
                $itk_component(date) icursor $icursor

                bell
                return -code break
            }

            if {$itk_option(-iq) == "high"} {
                set splist [split [$itk_component(date) get] "$split_char"]
                set year [lindex $splist [lsearch $order year]]

                if {$day > [set endday [_lastDay $month $year]]} {
                    set icursor [$itk_component(date) index insert]
                    $itk_component(date) delete $day_start_pos $day_end_pos
                    $itk_component(date) insert $day_start_pos $endday
                    $itk_component(date) icursor $icursor
                }
            }
        }
        if {$itk_option(-int)} {
            if {$icursor == $year_fourth_pos } {
                _setField month
            }
        }
        return -code break
    }
    
    #
    # Process the plus and the up arrow keys.  They both yeild the same
    # effect, they increment the day by one.
    #
    } elseif {($sym == "plus") || ($sym == "Up")} {
        if {[catch {show [clock scan "1 day" -base [get -clicks]]}] != 0} {
            bell
        }
        return -code break
    
        #
        # Process the minus and the down arrow keys which decrement the day.
        #
    } elseif {($sym == "minus") || ($sym == "Down")} {
        if {[catch {show [clock scan "-1 day" -base [get -clicks]]}] != 0} {
            bell
        }
        return -code break

        #
        # A tab key moves the day/month/year (or year/month/day) field
        # forward by one unless
        # the current field is the last field.  In that case we'll let tab
        # do what is supposed to and pass the focus onto the next widget.
        #
    } elseif {($sym == "Tab") && ($state == 0)} {
        if {$_cfield != "[lindex $order 2]"} {
            _moveField forward
            return -code break
        } else {
            _setField "[lindex $order 0]"
            return -code continue
        }

        #
        # A ctrl-tab key moves the day/month/year field backwards by one 
        # unless the current field is the the first field.  In that case we'll
        # let tab take the focus to a previous widget.
        #
    } elseif {($sym == "Tab") && ($state == 4)} {
        if {$_cfield != "[lindex $order 0]"} {
            _moveField backward
            return -code break
        } else {
            set _cfield "[lindex $order 0]"
            return -code continue
        }

        #
        # A right arrow key moves the insert cursor to the right one.
        #
    } elseif {$sym == "Right"} {
        _forward
        return -code break

        #
        # A left arrow, backspace, or delete key moves the insert cursor 
        # to the left one.  This is what you expect for the left arrow
        # and since the whole widget always operates in overstrike mode,
        # it makes the most sense for backspace and delete to do the same.
        #
    } elseif {$sym == "Left" || $sym == "BackSpace" || $sym == "Delete"} {
        _backward
        return -code break

    } elseif {($sym == "Control_L") || ($sym == "Shift_L") || \
            ($sym == "Control_R") || ($sym == "Shift_R")} {
        return -code break

        #
        # A Return key invokes the optionally specified command option.
        #
    } elseif {$sym == "Return"} {
        uplevel #0 $itk_option(-command)
        return -code break 
    } else {
        bell
        return -code break
    }
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _setField field
#
# Internal method which adjusts the field to be that of the 
# argument, setting the insert cursor appropriately.
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::_setField {field} {
    set _cfield $field
    
    if {$itk_option(-int)} {
        set year_pos 2
        set month_pos 5
        set day_pos 8
    } else {
        set month_pos 0
        set day_pos 3
        set year_pos 8
    }

    switch $field {
        "month" {
            $itk_component(date) icursor $month_pos
        }
        "day" {
            $itk_component(date) icursor $day_pos
        }
        "year" {
            $itk_component(date) icursor $year_pos
        }
        default {
            error "bad field: \"$field\", must be month, day or year"
        }
    }
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _moveField
#
# Internal method for moving the field forward or backward by one.
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::_moveField {direction} {

    set index [lsearch $_fields $_cfield]

    if {$direction == "forward"} {
        set newIndex [expr {$index + 1}]
    } else {
        set newIndex [expr {$index - 1}]
    }

    if {$newIndex == [llength $_fields]} {
        set newIndex 0
    }
    if {$newIndex < 0} {
        set newIndex [expr {[llength $_fields] - 1}]
    }

    _setField [lindex $_fields $newIndex]

    return
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _whichField
#
# Internal method which returns the current field that the cursor
# is currently within.
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::_whichField {} {
    set icursor [$itk_component(date) index insert]

    if {$itk_option(-int)} {
        switch $icursor {
            0 - 1 - 2 - 3 {
                set _cfield "year"
            }
            5 - 6 {
                set _cfield "month"
            }
            8 - 9 {
                set _cfield "day"
            }
        }
    } else {
        switch $icursor {
            0 - 1 {
            set _cfield "month"
            }
            3 - 4 {
            set _cfield "day"
            }
            6 - 7 - 8 - 9 {
            set _cfield "year"
            }
        }
    }
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _forward
#
# Internal method which moves the cursor forward by one character
# jumping over the slashes and wrapping.
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::_forward {} {
    set icursor [$itk_component(date) index insert]

    if {$itk_option(-int)} {
        switch $icursor {
            3 {
                _setField month
            }
            6 {
            _setField day
            }
            9 - 10 {
            _setField year
            }
            default {
            $itk_component(date) icursor [expr {$icursor + 1}]
            }
        }
    } else {
        switch $icursor {
            1 {
            _setField day
            }
            4 {
            _setField year
            }
            9 - 10 {
            _setField month
            }
            default {
            $itk_component(date) icursor [expr {$icursor + 1}]
            }
        }
    }
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _backward
#
# Internal method which moves the cursor backward by one character
# jumping over the slashes and wrapping.
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::_backward {} {
    set icursor [$itk_component(date) index insert]
    if {$itk_option(-int)} {
        switch $icursor {
            8 {
            _setField month
            }
            5 {
            _setField year
            }
            0 {
            _setField day
            }
            default {
            $itk_component(date) icursor [expr {$icursor -1}]
            }
        }
    } else {
        switch $icursor {
            6 {
                _setField day
            }
            3 {
                _setField month
            }
            0 {
                _setField year
            }
            default {
                $itk_component(date) icursor [expr {$icursor -1}]
            }
        }
    }
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _lastDay month year
#
# Internal method which determines the last day of the month for
# the given month and year.  We start at 28 and go forward till
# we fail.  Crude but effective.
# ------------------------------------------------------------------
itcl::body iwidgets::Datefield::_lastDay {month year} {
    set lastone 28

    for {set lastone 28} {$lastone < 32} {incr lastone} {
        set nextone [expr $lastone + 1]
        if {[catch {clock scan $month/$nextone/$year}] != 0} {
            return $lastone
        }
    }
}

Added library/dialog.itk.

























































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#
# Dialog
# ----------------------------------------------------------------------
# Implements a standard dialog box providing standard buttons and a 
# child site for use in derived classes.  The buttons include ok, apply,
# cancel, and help.  Options exist to configure the buttons.
#    
# ----------------------------------------------------------------------
#  AUTHOR: Mark L. Ulferts              EMAIL: mulferts@austin.dsccc.com
#
#  @(#) $Id: dialog.itk,v 1.2 2001/08/07 19:56:47 smithc Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1995 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Dialog {
    keep -background -cursor -foreground -modality 
}

# ------------------------------------------------------------------
#                            DIALOG
# ------------------------------------------------------------------
itcl::class iwidgets::Dialog {
    inherit iwidgets::Dialogshell

    constructor {args} {}
}

#
# Provide a lowercased access method for the Dialog class.
# 
proc ::iwidgets::dialog {pathName args} {
    uplevel ::iwidgets::Dialog $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *Dialog.master "." widgetDefault

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Dialog::constructor {args} {
    #
    # Add the standard buttons: OK, Apply, Cancel, and Help, making
    # OK be the default button.
    #
    add OK -text OK -command [itcl::code $this deactivate 1]
    add Apply -text Apply
    add Cancel -text Cancel -command [itcl::code $this deactivate 0]
    add Help -text Help
    
    default OK
    
    #
    # Bind the window manager delete protocol to invocation of the
    # cancel button.  This can be overridden by the user via the
    # execution of a similar command outside the class.
    #
    wm protocol $itk_component(hull) WM_DELETE_WINDOW \
	[itcl::code $this invoke Cancel]
    
    #
    # Initialize the widget based on the command line options.
    #
    eval itk_initialize $args
}

Added library/dialogshell.itk.





























































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
# Dialogshell
# ----------------------------------------------------------------------
# This class is implements a dialog shell which is a top level widget
# composed of a button box, separator, and child site area.  The class
# also has methods to control button construction.
#    
# ----------------------------------------------------------------------
#  AUTHOR: Mark L. Ulferts              EMAIL: mulferts@austin.dsccc.com
#
#  @(#) $Id: dialogshell.itk,v 1.3 2001/08/15 18:32:02 smithc Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1995 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Dialogshell {
    keep -background -cursor -foreground -modality 
}

# ------------------------------------------------------------------
#                            DIALOGSHELL
# ------------------------------------------------------------------
itcl::class iwidgets::Dialogshell {
    inherit iwidgets::Shell

    constructor {args} {}

    itk_option define -thickness thickness Thickness 3
    itk_option define -buttonboxpos buttonBoxPos Position s
    itk_option define -separator separator Separator on
    itk_option define -padx padX Pad 10
    itk_option define -pady padY Pad 10

    public method childsite {}
    public method index {args}
    public method add {args}
    public method insert {args}
    public method delete {args}
    public method hide {args}
    public method show {args}
    public method default {args}
    public method invoke {args}
    public method buttonconfigure {args}
    public method buttoncget {index option}
}

#
# Provide a lowercased access method for the Dialogshell class.
# 
proc ::iwidgets::dialogshell {pathName args} {
    uplevel ::iwidgets::Dialogshell $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *Dialogshell.master "." widgetDefault

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::constructor {args} {
    itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady

    #
    # Create the user child site, separator, and button box,
    #
    itk_component add -protected dschildsite {
	frame $itk_interior.dschildsite
    } 
    
    itk_component add separator {
	frame $itk_interior.separator -relief sunken 
    } 
    
    itk_component add bbox {
	iwidgets::Buttonbox $itk_interior.bbox
    } {
	usual

	rename -padx -buttonboxpadx buttonBoxPadX Pad
	rename -pady -buttonboxpady buttonBoxPadY Pad
    }
    
    #
    # Set the itk_interior variable to be the childsite for derived 
    # classes.
    #
    set itk_interior $itk_component(dschildsite)
    
    #
    # Set up the default button so that if <Return> is pressed in
    # any widget, it will invoke the default button.
    #
    bind $itk_component(hull) <Return> [itcl::code $this invoke]
    
    #
    # Initialize the widget based on the command line options.
    #
    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -thickness
#
# Specifies the thickness of the separator.  It sets the width and
# height of the separator to the thickness value and the borderwidth
# to half the thickness.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Dialogshell::thickness {
    $itk_component(separator) config -height $itk_option(-thickness)
    $itk_component(separator) config -width $itk_option(-thickness)
    $itk_component(separator) config \
	    -borderwidth [expr {$itk_option(-thickness) / 2}]
}

# ------------------------------------------------------------------
# OPTION: -buttonboxpos
#
# Specifies the position of the button box relative to the child site.
# The separator appears between the child site and button box.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Dialogshell::buttonboxpos {
    set parent [winfo parent $itk_component(bbox)]

    switch $itk_option(-buttonboxpos) {
	n {
	    $itk_component(bbox) configure -orient horizontal

	    grid $itk_component(bbox) -row 0 -column 0 -sticky ew
	    grid $itk_component(separator) -row 1 -column 0 -sticky ew
	    grid $itk_component(dschildsite) -row 2 -column 0 -sticky nsew

	    grid rowconfigure $parent 0 -weight 0
	    grid rowconfigure $parent 1 -weight 0
	    grid rowconfigure $parent 2 -weight 1
	    grid columnconfigure $parent 0 -weight 1
	    grid columnconfigure $parent 1 -weight 0
	    grid columnconfigure $parent 2 -weight 0
	}
	s {
	    $itk_component(bbox) configure -orient horizontal

	    grid $itk_component(dschildsite) -row 0 -column 0 -sticky nsew
	    grid $itk_component(separator) -row 1 -column 0 -sticky ew
	    grid $itk_component(bbox) -row 2 -column 0 -sticky ew

	    grid rowconfigure $parent 0 -weight 1
	    grid rowconfigure $parent 1 -weight 0
	    grid rowconfigure $parent 2 -weight 0
	    grid columnconfigure $parent 0 -weight 1
	    grid columnconfigure $parent 1 -weight 0
	    grid columnconfigure $parent 2 -weight 0
	}
	w {
	    $itk_component(bbox) configure -orient vertical

	    grid $itk_component(bbox) -row 0 -column 0 -sticky ns
	    grid $itk_component(separator) -row 0 -column 1 -sticky ns
	    grid $itk_component(dschildsite) -row 0 -column 2 -sticky nsew

	    grid rowconfigure $parent 0 -weight 1
	    grid rowconfigure $parent 1 -weight 0
	    grid rowconfigure $parent 2 -weight 0
	    grid columnconfigure $parent 0 -weight 0
	    grid columnconfigure $parent 1 -weight 0
	    grid columnconfigure $parent 2 -weight 1
	}
	e {
	    $itk_component(bbox) configure -orient vertical

	    grid $itk_component(dschildsite) -row 0 -column 0 -sticky nsew
	    grid $itk_component(separator) -row 0 -column 1 -sticky ns
	    grid $itk_component(bbox) -row 0 -column 2 -sticky ns

	    grid rowconfigure $parent 0 -weight 1
	    grid rowconfigure $parent 1 -weight 0
	    grid rowconfigure $parent 2 -weight 0
	    grid columnconfigure $parent 0 -weight 1
	    grid columnconfigure $parent 1 -weight 0
	    grid columnconfigure $parent 2 -weight 0
	}
	default {
	    error "bad buttonboxpos option\
		    \"$itk_option(-buttonboxpos)\": should be n,\
		    s, e, or w"
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -separator 
#
# Boolean option indicating wheather to display the separator.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Dialogshell::separator {
    if {$itk_option(-separator)} {
	$itk_component(separator) configure -relief sunken
    } else {
	$itk_component(separator) configure -relief flat
    }
}

# ------------------------------------------------------------------
# OPTION: -padx
#
# Specifies a padding distance for the childsite in the X-direction.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Dialogshell::padx {
    grid configure $itk_component(dschildsite) -padx $itk_option(-padx)
}

# ------------------------------------------------------------------
# OPTION: -pady
#
# Specifies a padding distance for the childsite in the Y-direction.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Dialogshell::pady {
    grid configure $itk_component(dschildsite) -pady $itk_option(-pady)
}
    
# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: childsite
#
# Return the pathname of the user accessible area.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::childsite {} {
    return $itk_component(dschildsite)
}

# ------------------------------------------------------------------
# METHOD: index index
#
# Thin wrapper of Buttonbox's index method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::index {args} {
    uplevel $itk_component(bbox) index $args
}

# ------------------------------------------------------------------
# METHOD: add tag ?option value ...?
#
# Thin wrapper of Buttonbox's add method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::add {args} {
    uplevel $itk_component(bbox) add $args
}

# ------------------------------------------------------------------
# METHOD: insert index tag ?option value ...?
#
# Thin wrapper of Buttonbox's insert method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::insert {args} {
    uplevel $itk_component(bbox) insert $args
}

# ------------------------------------------------------------------
# METHOD: delete tag
#
# Thin wrapper of Buttonbox's delete method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::delete {args} {
    uplevel $itk_component(bbox) delete $args
}

# ------------------------------------------------------------------
# METHOD: hide index
#
# Thin wrapper of Buttonbox's hide method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::hide {args} {
    uplevel $itk_component(bbox) hide $args
}

# ------------------------------------------------------------------
# METHOD: show index
#
# Thin wrapper of Buttonbox's show method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::show {args} {
    uplevel $itk_component(bbox) show $args
}

# ------------------------------------------------------------------
# METHOD: default index
#
# Thin wrapper of Buttonbox's default method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::default {args} {
    uplevel $itk_component(bbox) default $args
}

# ------------------------------------------------------------------
# METHOD: invoke ?index?
#
# Thin wrapper of Buttonbox's invoke method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::invoke {args} {
    uplevel $itk_component(bbox) invoke $args
}

# ------------------------------------------------------------------
# METHOD: buttonconfigure index ?option? ?value option value ...?
#
# Thin wrapper of Buttonbox's buttonconfigure method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::buttonconfigure {args} {
    uplevel $itk_component(bbox) buttonconfigure $args
}

# ------------------------------------------------------------------
# METHOD: buttoncget index option
#
# Thin wrapper of Buttonbox's buttoncget method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::buttoncget {index option} {
  uplevel $itk_component(bbox) buttoncget [list $index] \
  	[list $option]
}

Added library/disjointlistbox.itk.











































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
#
# ::iwidgets::Disjointlistbox
# ----------------------------------------------------------------------
# Implements a widget which maintains a disjoint relationship between
# the items displayed by two listboxes.  The disjointlistbox is composed
# of 2 Scrolledlistboxes,  2 Pushbuttons, and 2 labels.
#
# The disjoint behavior of this widget exists between the two Listboxes,
# That is, a given instance of a ::iwidgets::Disjointlistbox will never
# exist which has Listbox widgets with items in common.
#
# Users may transfer items between the two Listbox widgets using the
# the two Pushbuttons.
#
# The options include the ability to configure the "items" displayed by
# either of the two Listboxes and to control the placement of the insertion
# and removal buttons.
#
# The following depicts the allowable "-buttonplacement" option values
# and their associated layout:
#
#   "-buttonplacement" => center
#
#   --------------------------
#   |listbox|        |listbox|
#   |       |________|       |
#   | (LHS) | button | (RHS) |
#   |       |========|       |
#   |       | button |       |
#   |_______|--------|_______|
#   | count |        | count |
#   --------------------------
#
#   "-buttonplacement" => bottom
#
#   ---------------------
#   | listbox | listbox |
#   |  (LHS)  |  (RHS)  |
#   |_________|_________|
#   | button  | button  |
#   |---------|---------|
#   | count   | count   |
#   ---------------------
#
# ----------------------------------------------------------------------
#  AUTHOR: John A. Tucker               EMAIL: jatucker@spd.dsccc.com
#
# ======================================================================

#
# Default resources.
#
option add *Disjointlistbox.lhsLabelText    Available   widgetDefault
option add *Disjointlistbox.rhsLabelText    Current     widgetDefault
option add *Disjointlistbox.lhsButtonLabel  {Insert >>} widgetDefault
option add *Disjointlistbox.rhsButtonLabel  {<< Remove} widgetDefault
option add *Disjointlistbox.vscrollMode     static      widgetDefault
option add *Disjointlistbox.hscrollMode     static      widgetDefault
option add *Disjointlistbox.selectMode      multiple    widgetDefault
option add *Disjointlistbox.labelPos        nw          widgetDefault
option add *Disjointlistbox.buttonPlacement bottom      widgetDefault
option add *Disjointlistbox.lhsSortOption   increasing  widgetDefault
option add *Disjointlistbox.rhsSortOption   increasing  widgetDefault


#
# Usual options.
#
itk::usual Disjointlistbox {
  keep -background -textbackground -cursor \
       -foreground -textfont -labelfont
}


# ----------------------------------------------------------------------
# ::iwidgets::Disjointlistbox 
# ----------------------------------------------------------------------
itcl::class ::iwidgets::Disjointlistbox {

  inherit itk::Widget

  #
  # options
  #
  itk_option define -buttonplacement buttonPlacement ButtonPlacement bottom
  itk_option define -lhsbuttonlabel  lhsButtonLabel  LabelText       {Insert >>}
  itk_option define -rhsbuttonlabel  rhsButtonLabel  LabelText       {<< Remove}
  itk_option define -lhssortoption   lhsSortOption   LhsSortOption   increasing
  itk_option define -rhssortoption   rhsSortOption   RhsSortOption   increasing

  constructor {args} {}

  #
  # PUBLIC
  #
  public {
    method clear {}
    method getlhs {{first 0} {last end}}
    method getrhs {{first 0} {last end}}
    method lhs {args}
    method insertlhs {items}
    method insertrhs {items}
    method setlhs {items}
    method setrhs {items}
    method rhs {args}
  }

  #
  # PROTECTED
  #
  protected {
    method insert {theListbox items}
    method listboxClick {clickSide otherSide}
    method listboxDblClick {clickSide otherSide}
    method remove {theListbox items}
    method showCount {}
    method transfer {}

    variable sourceListbox {}
    variable destinationListbox {}
  }
}

#
# Provide a lowercased access method for the ::iwidgets::Disjointlistbox class.
# 
proc ::iwidgets::disjointlistbox {pathName args} {
    uplevel ::iwidgets::Disjointlistbox $pathName $args
}

# ------------------------------------------------------------------
#
# Method: Constructor
#
# Purpose:   
#
itcl::body ::iwidgets::Disjointlistbox::constructor {args} {
    #
    # Create the left-most Listbox
    #
    itk_component add lhs {
        iwidgets::Scrolledlistbox $itk_interior.lhs \
                -selectioncommand [itcl::code $this listboxClick lhs rhs] \
                -dblclickcommand [itcl::code $this listboxDblClick lhs rhs]
    } {
        usual
        keep -selectmode -vscrollmode -hscrollmode
        rename -labeltext -lhslabeltext lhsLabelText LabelText
    }

    #
    # Create the right-most Listbox
    #
    itk_component add rhs {
        iwidgets::Scrolledlistbox $itk_interior.rhs \
                -selectioncommand [itcl::code $this listboxClick rhs lhs] \
                -dblclickcommand [itcl::code $this listboxDblClick rhs lhs]
    } {
        usual
        keep -selectmode -vscrollmode -hscrollmode
        rename -labeltext -rhslabeltext rhsLabelText LabelText
    }

    #
    # Create the left-most item count Label
    #
    itk_component add lhsCount {
        label $itk_interior.lhscount
    } {
        usual
        rename -font -labelfont labelFont Font
    }

    #
    # Create the right-most item count Label
    #
    itk_component add rhsCount {
        label $itk_interior.rhscount
    } {
        usual
        rename -font -labelfont labelFont Font
    }

    set sourceListbox $itk_component(lhs)
    set destinationListbox $itk_component(rhs)

    #
    # Bind the "showCount" method to the Map event of one of the labels
    # to keep the diplayed item count current.
    #
    bind $itk_component(lhsCount) <Map> [itcl::code $this showCount]

    grid $itk_component(lhs) -row 0 -column 0 -sticky nsew
    grid $itk_component(rhs) -row 0 -column 2 -sticky nsew

    grid rowconfigure    $itk_interior 0 -weight 1
    grid columnconfigure $itk_interior 0 -weight 1
    grid columnconfigure $itk_interior 2 -weight 1

    eval itk_initialize $args
}

# ------------------------------------------------------------------
# Method:  listboxClick
#
# Purpose: Evaluate a single click make in the specified Listbox.
#
itcl::body ::iwidgets::Disjointlistbox::listboxClick {clickSide otherSide} {
    set button "button"
    $itk_component($clickSide$button) configure -state active
    $itk_component($otherSide$button) configure -state disabled
    set sourceListbox      $clickSide
    set destinationListbox $otherSide
}

# ------------------------------------------------------------------
# Method:  listboxDblClick
#
# Purpose: Evaluate a double click in the specified Listbox.
#
itcl::body ::iwidgets::Disjointlistbox::listboxDblClick {clickSide otherSide} {
    listboxClick $clickSide $otherSide
    transfer
}

# ------------------------------------------------------------------
# Method:  transfer
#
# Purpose: Transfer source Listbox items to destination Listbox
#
itcl::body ::iwidgets::Disjointlistbox::transfer {} {

    if {[$sourceListbox selecteditemcount] == 0} {
        return
    }
    set selectedindices [lsort -integer -decreasing [$sourceListbox curselection]]
    set selecteditems [$sourceListbox getcurselection]

    foreach index $selectedindices {
        $sourceListbox delete $index
    }

    foreach item $selecteditems {
        $destinationListbox insert end $item
    }

    if {![string equal $itk_option(-${destinationListbox}sortoption) "none"]} {
        $destinationListbox sort $itk_option(-${destinationListbox}sortoption)
    }

    showCount
}

# ------------------------------------------------------------------
# Method: getlhs
#
# Purpose: Retrieve the items of the left Listbox widget
#
itcl::body ::iwidgets::Disjointlistbox::getlhs {{first 0} {last end}} {
    return [lhs get $first $last]
}

# ------------------------------------------------------------------
# Method: getrhs
#
# Purpose: Retrieve the items of the right Listbox widget
#
itcl::body ::iwidgets::Disjointlistbox::getrhs {{first 0} {last end}} {
    return [rhs get $first $last]
}

# ------------------------------------------------------------------
# Method: insertrhs
#
# Purpose: Insert items into the right Listbox widget
#
itcl::body ::iwidgets::Disjointlistbox::insertrhs {items} {
    remove $itk_component(lhs) $items
    insert rhs $items
}

# ------------------------------------------------------------------
# Method: insertlhs
#
# Purpose: Insert items into the left Listbox widget
#
itcl::body ::iwidgets::Disjointlistbox::insertlhs {items} {
    remove $itk_component(rhs) $items
    insert lhs $items
}

# ------------------------------------------------------------------
# Method:  clear
#
# Purpose: Remove the items from the Listbox widgets and set the item count
#          Labels text to 0
#
itcl::body ::iwidgets::Disjointlistbox::clear {} {
    lhs clear
    rhs clear
    showCount
}

# ------------------------------------------------------------------
# Method: insert
#
# Purpose: Insert the input items into the input Listbox widget while
#          maintaining the disjoint property between them.
#
itcl::body ::iwidgets::Disjointlistbox::insert {theListbox items} {

    set curritems [$theListbox get 0 end]

    foreach item $items {
        #
        # if the item is not already present in the Listbox then insert it
        #
        if {[lsearch -exact $curritems $item] == -1} {
            $theListbox insert end $item
        }
    }

    if {![string equal $itk_option(-${theListbox}sortoption) "none"]} {
        $theListbox sort $itk_option(-${theListbox}sortoption)
    }

    showCount
}

# ------------------------------------------------------------------
# Method: remove
#
# Purpose: Remove the input items from the input Listbox widget while
#          maintaining the disjoint property between them.
#
itcl::body ::iwidgets::Disjointlistbox::remove {theListbox items} {

    set indexes {}
    set curritems [$theListbox get 0 end]

    foreach item $items {
        #
        # if the item is in the listbox then add its index to the index list
        # 
        if {[set index [lsearch -exact $curritems $item]] != -1} {
            lappend indexes $index
        }
    }

    foreach index [lsort -integer -decreasing $indexes] {
        $theListbox delete $index
    }
    showCount
}

# ------------------------------------------------------------------
# Method: showCount
#
# Purpose: Set the text of the item count Labels.
#
itcl::body ::iwidgets::Disjointlistbox::showCount {} {
    $itk_component(lhsCount) config -text "item count: [lhs size]"
    $itk_component(rhsCount) config -text "item count: [rhs size]"
}

# ------------------------------------------------------------------
# METHOD: setlhs
#
# Set the items of the left-most Listbox with the input list
# option.  Remove all (if any) items from the right-most Listbox
# which exist in the input list option to maintain the disjoint
# property between the two
#
itcl::body ::iwidgets::Disjointlistbox::setlhs {items} {
    lhs clear
    insertlhs $items
}

# ------------------------------------------------------------------
# METHOD: setrhs
#
# Set the items of the right-most Listbox with the input list
# option.  Remove all (if any) items from the left-most Listbox
# which exist in the input list option to maintain the disjoint
# property between the two
#
itcl::body ::iwidgets::Disjointlistbox::setrhs {items} {
    rhs clear
    insertrhs $items
}

# ------------------------------------------------------------------
# Method:  lhs
#
# Purpose: Evaluates the specified arguments against the lhs Listbox
#
itcl::body ::iwidgets::Disjointlistbox::lhs {args} {
    return [eval $itk_component(lhs) $args]
}

# ------------------------------------------------------------------
# Method:  rhs
#
# Purpose: Evaluates the specified arguments against the rhs Listbox
#
itcl::body ::iwidgets::Disjointlistbox::rhs {args} {
    return [eval $itk_component(rhs) $args]
}

# ------------------------------------------------------------------
# OPTION: buttonplacement
#
# Configure the placement of the buttons to be either between or below
# the two list boxes.
#
itcl::configbody ::iwidgets::Disjointlistbox::buttonplacement {
    if {$itk_option(-buttonplacement) != ""} {

        if { [lsearch [component] lhsbutton] != -1 } {
            eval destroy $itk_component(rhsbutton) $itk_component(lhsbutton)
        }

        if { [lsearch [component] bbox] != -1 } {
            destroy $itk_component(bbox)
        }

        set where $itk_option(-buttonplacement)

        switch $where {

            center {
                #
                # Create the button box frame
                #
                itk_component add bbox {
                    frame $itk_interior.bbox
                }
    
                itk_component add lhsbutton {
                    button $itk_component(bbox).lhsbutton -command [itcl::code \
                            $this transfer]
                } {
                    usual
                    rename -text -lhsbuttonlabel lhsButtonLabel LabelText
                    rename -font -labelfont labelFont Font
                }
    
                itk_component add rhsbutton {
                    button $itk_component(bbox).rhsbutton -command [itcl::code \
                            $this transfer]
                } {
                    usual
                    rename -text -rhsbuttonlabel rhsButtonLabel LabelText
                    rename -font -labelfont labelFont Font
                }
    
                grid configure $itk_component(lhsCount) -row 1 -column 0 \
                        -sticky ew
                grid configure $itk_component(rhsCount) -row 1 -column 2 \
                        -sticky ew
     
                grid configure $itk_component(bbox) \
                        -in $itk_interior -row 0 -column 1 -columnspan 1 \
                                -sticky nsew

		# Tk8.5: enforce compatibility to previous versions
		# see Tk-ticket 2062394
		catch {grid anchor $itk_component(bbox) center}

                grid configure $itk_component(rhsbutton) \
                        -in $itk_component(bbox) -row 0 -column 0 -sticky ew
                grid configure $itk_component(lhsbutton) \
                        -in $itk_component(bbox) -row 1 -column 0 -sticky ew
                }

            bottom {
    
                itk_component add lhsbutton {
                    button $itk_interior.lhsbutton -command [itcl::code $this \
                            transfer]
                } {
                    usual
                    rename -text -lhsbuttonlabel lhsButtonLabel LabelText
                    rename -font -labelfont labelFont Font
                }

                itk_component add rhsbutton {
                    button $itk_interior.rhsbutton -command [itcl::code $this \
                            transfer]
                } {
                    usual
                    rename -text -rhsbuttonlabel rhsButtonLabel LabelText
                    rename -font -labelfont labelFont Font
                }

                grid $itk_component(lhsCount)  -row 2 -column 0 -sticky ew
                grid $itk_component(rhsCount)  -row 2 -column 2 -sticky ew
                grid $itk_component(lhsbutton) -row 1 -column 0 -sticky ew
                grid $itk_component(rhsbutton) -row 1 -column 2 -sticky ew
            }

            default {
                error "bad buttonplacement option\"$where\": should be center\
                        or bottom"
            }
        }
    }
}

# ------------------------------------------------------------------
# OPTION: lhssortoption
#
# Configure the sort option to use for the left side
#
itcl::configbody ::iwidgets::Disjointlistbox::lhssortoption {

    if {![string equal $itk_option(-lhssortoption) "none"]} {
        $itk_component(lhs) sort $itk_option(-lhssortoption)
    }
}


# ------------------------------------------------------------------
# OPTION: rhssortoption
#
# Configure the sort option to use for the right side
#
itcl::configbody ::iwidgets::Disjointlistbox::rhssortoption {

    if {![string equal $itk_option(-rhssortoption) "none"]} {
        $itk_component(rhs) sort $itk_option(-rhssortoption)
    }
}

Added library/entryfield.itk.





































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
#
# Entryfield
# ----------------------------------------------------------------------
# Implements an enhanced text entry widget.
#
# ----------------------------------------------------------------------
#   AUTHOR:  Sue Yockey               E-mail: yockey@acm.org
#            Mark L. Ulferts          E-mail: mulferts@austin.dsccc.com
#
#   @(#) $Id: entryfield.itk,v 1.7 2002/09/23 05:10:38 mgbacke Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1995 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Entryfield {
    keep -background -borderwidth -cursor -foreground -highlightcolor \
	 -highlightthickness -insertbackground -insertborderwidth \
	 -insertofftime -insertontime -insertwidth -labelfont \
	 -selectbackground -selectborderwidth -selectforeground \
	 -textbackground -textfont
}

# ------------------------------------------------------------------
#                            ENTRYFIELD
# ------------------------------------------------------------------
itcl::class iwidgets::Entryfield {
    inherit iwidgets::Labeledwidget 
    
    constructor {args} {}

    itk_option define -childsitepos childSitePos Position e
    itk_option define -command command Command {}
    itk_option define -fixed fixed Fixed 0
    itk_option define -focuscommand focusCommand Command {}
    itk_option define -invalid invalid Command {bell}
    itk_option define -pasting pasting Behavior 1
    itk_option define -validate validate Command {}
    
    public {
	method childsite {}
	method get {}
	method delete {args}
	method icursor {args}
	method index {args}
	method insert {args}
	method scan {args}
	method selection {args}
	method xview {args}
	method clear {}
    }

    proc numeric {char} {}
    proc integer {string} {}
    proc alphabetic {char} {}
    proc alphanumeric {char} {}
    proc hexidecimal {string} {}
    proc real {string} {}

    protected {
	method _focusCommand {}
	method _keyPress {char sym state}
    }

    private method _peek {char}
    private method _checkLength {}
}

#
# Provide a lowercased access method for the Entryfield class.
# 
proc ::iwidgets::entryfield {pathName args} {
    uplevel ::iwidgets::Entryfield $pathName $args
}

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::constructor {args} {
    component hull configure -borderwidth 0
    
    itk_component add entry {
	    entry $itk_interior.entry
    } {
	keep -borderwidth -cursor -exportselection \
		-foreground -highlightcolor \
		-highlightthickness -insertbackground -insertborderwidth \
		-insertofftime -insertontime -insertwidth -justify \
		-relief -selectbackground -selectborderwidth \
		-selectforeground -show -state -textvariable -width
	
	rename -font -textfont textFont Font
	rename -highlightbackground -background background Background
	rename -background -textbackground textBackground Background
    }
    
    #
    # Create the child site widget.
    #
    itk_component add -protected efchildsite {
	    frame $itk_interior.efchildsite
    } 
    set itk_interior $itk_component(efchildsite)
    
    #
    # Entryfield instance bindings.
    #
    bind $itk_component(entry) <KeyPress> [itcl::code $this _keyPress %A %K %s]
    bind $itk_component(entry) <FocusIn> [itcl::code $this _focusCommand]

    #
    # Initialize the widget based on the command line options.
    #
    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -command
#
# Command associated upon detection of Return key press event
# ------------------------------------------------------------------
itcl::configbody iwidgets::Entryfield::command {}

# ------------------------------------------------------------------
# OPTION: -focuscommand
#
# Command associated upon detection of focus.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Entryfield::focuscommand {}

# ------------------------------------------------------------------
# OPTION: -validate
#
# Specify a command to executed for the validation of Entryfields.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Entryfield::validate {
    switch $itk_option(-validate) {
	{} {
	    set itk_option(-validate) {}
	}
	numeric {
	    set itk_option(-validate) "::iwidgets::Entryfield::numeric %c"
	}
	integer {
	    set itk_option(-validate) "::iwidgets::Entryfield::integer %P"
	}
	hexidecimal {
	    set itk_option(-validate) "::iwidgets::Entryfield::hexidecimal %P"
	}
	real {
	    set itk_option(-validate) "::iwidgets::Entryfield::real %P"
	}
	alphabetic {
	    set itk_option(-validate) "::iwidgets::Entryfield::alphabetic %c"
	}
	alphanumeric {
	    set itk_option(-validate) "::iwidgets::Entryfield::alphanumeric %c"
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -invalid
#
# Specify a command to executed should the current Entryfield contents
# be proven invalid.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Entryfield::invalid {}

# ------------------------------------------------------------------
# OPTION: -pasting
#
# Allows the developer to enable and disable pasting into the entry
# component of the entryfield.  This is done to avoid potential stack
# dumps when using the -validate configuration option.  Plus, it's just
# a good idea to have complete control over what you allow the user
# to enter into the entryfield.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Entryfield::pasting {
    set oldtags [bindtags $itk_component(entry)]
    if {[lindex $oldtags 0] != "pastetag"} {
        bindtags $itk_component(entry) [linsert $oldtags 0 pastetag] 
    }

    if {($itk_option(-pasting))} {
        bind pastetag <ButtonRelease-2> [itcl::code $this _checkLength]
        bind pastetag <Control-v> [itcl::code $this _checkLength]
        bind pastetag <Insert> [itcl::code $this _checkLength]
        bind pastetag <KeyPress> {}
    } else {
        bind pastetag <ButtonRelease-2> {break}
        bind pastetag <Control-v> {break}
        bind pastetag <Insert> {break}
        bind pastetag <KeyPress> {
            # Disable function keys > F9.
            if {[regexp {^F[1,2][0-9]+$} "%K"]} {
	            break
            }
        }
    }
}

# ------------------------------------------------------------------
# OPTION: -fixed
#
# Restrict entry to 0 (unlimited) chars.  The value is the maximum 
# number of chars the user may type into the field, regardles of 
# field width, i.e. the field width may be 20, but the user will 
# only be able to type -fixed number of characters into it (or 
# unlimited if -fixed = 0).
# ------------------------------------------------------------------
itcl::configbody iwidgets::Entryfield::fixed {
    if {[regexp {[^0-9]} $itk_option(-fixed)] || \
	    ($itk_option(-fixed) < 0)} {
	error "bad fixed option \"$itk_option(-fixed)\",\
		should be positive integer"
    }
}

# ------------------------------------------------------------------
# OPTION: -childsitepos
#
# Specifies the position of the child site in the widget.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Entryfield::childsitepos {
    set parent [winfo parent $itk_component(entry)]

    switch $itk_option(-childsitepos) {
	n {
	    grid $itk_component(efchildsite) -row 0 -column 0 -sticky ew
	    grid $itk_component(entry) -row 1 -column 0 -sticky nsew

	    grid rowconfigure $parent 0 -weight 0
	    grid rowconfigure $parent 1 -weight 1
	    grid columnconfigure $parent 0 -weight 1
	    grid columnconfigure $parent 1 -weight 0
	}
	
	e {
	    grid $itk_component(efchildsite) -row 0 -column 1 -sticky ns
	    grid $itk_component(entry) -row 0 -column 0 -sticky nsew

	    grid rowconfigure $parent 0 -weight 1
	    grid rowconfigure $parent 1 -weight 0
	    grid columnconfigure $parent 0 -weight 1
	    grid columnconfigure $parent 1 -weight 0
	}
	
	s {
	    grid $itk_component(efchildsite) -row 1 -column 0 -sticky ew
	    grid $itk_component(entry) -row 0 -column 0 -sticky nsew

	    grid rowconfigure $parent 0 -weight 1
	    grid rowconfigure $parent 1 -weight 0
	    grid columnconfigure $parent 0 -weight 1
	    grid columnconfigure $parent 1 -weight 0
	}
	
	w {
	    grid $itk_component(efchildsite) -row 0 -column 0 -sticky ns
	    grid $itk_component(entry) -row 0 -column 1 -sticky nsew

	    grid rowconfigure $parent 0 -weight 1
	    grid rowconfigure $parent 1 -weight 0
	    grid columnconfigure $parent 0 -weight 0
	    grid columnconfigure $parent 1 -weight 1
	}
	
	default {
	    error "bad childsite option\
		    \"$itk_option(-childsitepos)\":\
		    should be n, e, s, or w"
	}
    }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: childsite
#
# Returns the path name of the child site widget.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::childsite {} {
    return $itk_component(efchildsite)
}

# ------------------------------------------------------------------
# METHOD: get 
#
# Thin wrap of the standard entry widget get method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::get {} {
    return [$itk_component(entry) get]
}

# ------------------------------------------------------------------
# METHOD: delete
#
# Thin wrap of the standard entry widget delete method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::delete {args} {
    return [eval $itk_component(entry) delete $args]
}

# ------------------------------------------------------------------
# METHOD: icursor 
#
# Thin wrap of the standard entry widget icursor method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::icursor {args} {
    return [eval $itk_component(entry) icursor $args]
}

# ------------------------------------------------------------------
# METHOD: index 
#
# Thin wrap of the standard entry widget index method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::index {args} {
    return [eval $itk_component(entry) index $args]
}

# ------------------------------------------------------------------
# METHOD: insert 
#
# Thin wrap of the standard entry widget index method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::insert {args} {
    return [eval $itk_component(entry) insert $args]
}

# ------------------------------------------------------------------
# METHOD: scan 
#
# Thin wrap of the standard entry widget scan method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::scan {args} {
    return [eval $itk_component(entry) scan $args]
}

# ------------------------------------------------------------------
# METHOD: selection
#
# Thin wrap of the standard entry widget selection method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::selection {args} {
    return [eval $itk_component(entry) selection $args]
}

# ------------------------------------------------------------------
# METHOD: xview 
#
# Thin wrap of the standard entry widget xview method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::xview {args} {
    return [eval $itk_component(entry) xview $args]
}

# ------------------------------------------------------------------
# METHOD: clear 
#
# Delete the current entry contents.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::clear {} {
    $itk_component(entry) delete 0 end
    icursor 0
}

# ------------------------------------------------------------------
# PROCEDURE: numeric char
#
# The numeric procedure validates character input for a given 
# Entryfield to be numeric and returns the result.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::numeric {char} {
    return [regexp {[0-9]} $char]
}

# ------------------------------------------------------------------
# PROCEDURE: integer string
#
# The integer procedure validates character input for a given 
# Entryfield to be integer and returns the result.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::integer {string} {
    return [regexp {^[-+]?[0-9]*$} $string]
}

# ------------------------------------------------------------------
# PROCEDURE: alphabetic char
#
# The alphabetic procedure validates character input for a given 
# Entryfield to be alphabetic and returns the result.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::alphabetic {char} {
    return [regexp -nocase {[a-z]} $char]
}

# ------------------------------------------------------------------
# PROCEDURE: alphanumeric char
#
# The alphanumeric procedure validates character input for a given 
# Entryfield to be alphanumeric and returns the result.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::alphanumeric {char} {
    return [regexp -nocase {[0-9a-z]} $char]
}

# ------------------------------------------------------------------
# PROCEDURE: hexadecimal string
#
# The hexidecimal procedure validates character input for a given 
# Entryfield to be hexidecimal and returns the result.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::hexidecimal {string} {
    return [regexp {^(0x)?[0-9a-fA-F]*$} $string]
}

# ------------------------------------------------------------------
# PROCEDURE: real string
#
# The real procedure validates character input for a given Entryfield
# to be real and returns the result.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::real {string} {
    return [regexp {^[-+]?[0-9]*\.?[0-9]*([0-9]\.?[eE][-+]?[0-9]*)?$} $string]
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _peek char
#
# The peek procedure returns the value of the Entryfield with the
# char inserted at the insert position.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::_peek {char} {
    set str [get]

    set insertPos [index insert] 
    set firstPart [string range $str 0 [expr {$insertPos - 1}]]
    set lastPart [string range $str $insertPos end]

    regsub -all {\\} "$char" {\\\\} char
    append rtnVal $firstPart $char $lastPart
    return $rtnVal
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _focusCommand
#
# Method bound to focus event which evaluates the current command
# specified in the focuscommand option
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::_focusCommand {} {
    uplevel #0 $itk_option(-focuscommand)
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _keyPress 
#
# Monitor the key press event checking for return keys, fixed width
# specification, and optional validation procedures.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::_keyPress {char sym state} {
    #
    # A Return key invokes the optionally specified command option.
    #
    if {$sym == "Return"} {
        if {$itk_option(-command) == ""} {
            #
            # Allow <Return> to propagate to parent if the -command option
            # isn't defined.
            #
            return -code continue 1
        }
	    uplevel #0 $itk_option(-command)
	    return -code break 1
    } 
    
    #
    # Tabs, BackSpace, and Delete are passed on for other bindings.
    #
    if {($sym == "Tab") || ($sym == "BackSpace") || ($sym == "Delete")} {
	    return -code continue 1
    }

    # 
    # Character is not printable or the state is greater than one which
    # means a modifier was used such as a control, meta key, or control
    # or meta key with numlock down.
    #
    #-----------------------------------------------------------
    # BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/15/99
    #-----------------------------------------------------------
    # The following conditional used to hardcode specific state values, such
    # as "4" and "8".  These values are used to detect <Ctrl>, <Shift>, etc.
    # key combinations.  On the windows platform, the <Alt> key is state
    # 16, and on the unix platform, the <Alt> key is state 8.  All <Ctrl>
    # and <Alt> combinations should be masked out, regardless of the
    # <NumLock> or <CapsLock> status, and regardless of platform.
    #-----------------------------------------------------------
    set CTRL 4
    global tcl_platform
    if {$tcl_platform(platform) == "unix"} {
        set ALT 8
    } elseif {$tcl_platform(platform) == "windows"} {
        set ALT 16
    } else {
        # This is something other than UNIX or WINDOWS.  Default to the
        # old behavior (UNIX).
        set ALT 8
    }
    # Thanks to Rolf Schroedter for the following elegant conditional.  This
    # masks out all <Ctrl> and <Alt> key combinations.
    if {($char == "") || ($state & ($CTRL | $ALT))} {
        return -code continue 1
    }

    #
    # If the fixed length option is not zero, then verify that the
    # current length plus one will not exceed the limit.  If so then
    # invoke the invalid command procedure.
    #
    if {$itk_option(-fixed) != 0} {
	    if {[string length [get]] >= $itk_option(-fixed)} {
	        uplevel #0 $itk_option(-invalid)
	        return -code break 0
	    }
    } 
    
    #
    # The validate option may contain a keyword (numeric, alphabetic),
    # the name of a procedure, or nothing.  The numeric and alphabetic
    # keywords engage typical base level checks.  If a command procedure
    # is specified, then invoke it with the object and character passed
    # as arguments.  If the validate procedure returns false, then the 
    # invalid procedure is called.
    #
    if {$itk_option(-validate) != {}} {
	    set cmd $itk_option(-validate)

	    regsub -all "%W" "$cmd" $itk_component(hull) cmd
	    regsub -all "%P" "$cmd" [list [_peek $char]] cmd
	    regsub -all "%S" "$cmd" [list [get]] cmd
	    regsub -all "%c" "$cmd" [list $char] cmd
        regsub -all {\\} "$cmd" {\\\\} cmd

	    set valid [uplevel #0 $cmd]
	
	    if {($valid == "") || ([regexp 0|false|off|no $valid])} {
	        uplevel #0 $itk_option(-invalid)
	        return -code break 0
	    }
    }
    
    return -code continue 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _checkLength
#
# This method was added by csmith for SF ticket 227912. We need to
# to check the clipboard content before allowing any pasting into
# the entryfield to disallow text that is longer than the value
# specified by the -fixed option.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::_checkLength {} {
    if {$itk_option(-fixed) != 0} {
        if {[catch {::selection get -selection CLIPBOARD} pending]} {
            # Nothing in the clipboard.  Check the primary selection.
            if {[catch {::selection get -selection PRIMARY} pending]} {
                # Nothing here either.  Goodbye.
                return
            }
        }
        set len [expr {[string length $pending] + [string length [get]]}]
        if {$len > $itk_option(-fixed)} {
            uplevel #0 $itk_option(-invalid)
            return -code break 0
        }
    }
}

Added library/extbutton.itk.















































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
#-------------------------------------------------------------------------------
# Extbutton
#-------------------------------------------------------------------------------
# This [incr Widget] is pretty simple - it just extends the behavior of
# the Tk button by allowing the user to add a bitmap or an image, which
# can be placed at various locations relative to the text via the -imagepos
# configuration option.
#
#-------------------------------------------------------------------------------
# IMPORTANT NOTE: This [incr Widget] will only work with Tk 8.4 or later.
#
#-------------------------------------------------------------------------------
# AUTHOR:  Chad Smith               E-mail: csmith@adc.com, itclguy@yahoo.com
#-------------------------------------------------------------------------------
# Permission to use, copy, modify, distribute, and license this software
# and its documentation for any purpose is hereby granted as long as this
# comment block remains intact.
#-------------------------------------------------------------------------------

#
# Default resources
#
option add *Extbutton.borderwidth 2 widgetDefault
option add *Extbutton.relief raised widgetDefault

#
# Usual options
#
itk::usual Extbutton {
  keep -cursor -font
}

itcl::class iwidgets::Extbutton {
  inherit itk::Widget

  constructor {args} {}

  itk_option define -activebackground activeBackground Foreground #ececec
  itk_option define -bd borderwidth BorderWidth 2
  itk_option define -bitmap bitmap Bitmap {}
  itk_option define -command command Command {}
  itk_option define -defaultring defaultring DefaultRing 0
  itk_option define -defaultringpad defaultringpad Pad 4
  itk_option define -image image Image {}
  itk_option define -imagepos imagePos Position w
  itk_option define -relief relief Relief raised
  itk_option define -state state State normal
  itk_option define -text text Text {}

  public method invoke {} {eval $itk_option(-command)}
  public method flash {}

  private method changeColor {event_}
  private method sink {}
  private method raise {} {configure -relief $_oldValues(-relief)}

  private variable _oldValues
}


#
# Provide the usual lowercase access command.
#
proc iwidgets::extbutton {path_ args} {
  uplevel iwidgets::Extbutton $path_ $args
}


#-------------------------------------------------------------------------------
# OPTION: -bd
#
# DESCRIPTION: This isn't a new option.  Similar to -image, we just need to
#   repack the frame when the borderwidth changes.  This option is kept by
#   the private reliefframe component.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::bd {
  pack $itk_component(frame) -padx 4 -pady 4
}


#-------------------------------------------------------------------------------
# OPTION: -bitmap
#
# DESCRIPTION: This isn't a new option - we just need to reset the -image option
#   so that the user can toggle back and forth between images and bitmaps.
#   Otherwise, the image will take precedence and the user will be unable to
#   change to a bitmap without manually setting the label component's -image to
#   an empty string.  This option is kept by the image component.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::bitmap {
  if {$itk_option(-bitmap) == ""} {
    return
  }
  if {$itk_option(-image) != ""} {
    configure -image {}
  }
  pack $itk_component(frame) -padx 4 -pady 4
}


#-------------------------------------------------------------------------------
# OPTION: -command
#
# DESCRIPTION: Invoke the given command to simulate the Tk button's -command
#   option.  The command is invoked on <ButtonRelease-1> events only or by
#   direct calls to the public invoke() method.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::command {
  if {$itk_option(-command) == ""} {
    return
  }

  # Only create the tag binding if the button is operable.
  if {$itk_option(-state) == "normal"} {
    bind $this-commandtag <ButtonRelease-1> [itcl::code $this invoke]
  }

  # Associate the tag with each component if it's not already done.
  if {[lsearch [bindtags $itk_interior] $this-commandtag] == -1} {
    foreach component [component] {
      bindtags [component $component] \
        [linsert [bindtags [component $component]] end $this-commandtag]
    }
  }
}


#-------------------------------------------------------------------------------
# OPTION: -defaultring
#
# DESCRIPTION: Controls display of the sunken frame surrounding the button.
#   This option simulates the pushbutton iwidget -defaultring option.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::defaultring {
  switch -- $itk_option(-defaultring) {
    1 {set ring 1}
    0 {set ring 0}
    default {
      error "Invalid option for -defaultring: \"$itk_option(-defaultring)\".  \
             Should be 1 or 0."
    }
  }

  if ($ring) {
    $itk_component(ring) configure -borderwidth 2
    pack $itk_component(reliefframe) -padx $itk_option(-defaultringpad) \
      -pady $itk_option(-defaultringpad)
  } else {
    $itk_component(ring) configure -borderwidth 0
    pack $itk_component(reliefframe) -padx 0 -pady 0
  }
}


#-------------------------------------------------------------------------------
# OPTION: -defaultringpad
#
# DESCRIPTION: The pad distance between the ring and the button.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::defaultringpad {
  # Must be an integer.
  if ![string is integer $itk_option(-defaultringpad)] {
    error "Invalid value specified for -defaultringpad:\
	   \"$itk_option(-defaultringpad)\".  Must be an integer."
  }

  # Let's go ahead and make the maximum padding 20 pixels.  Surely no one
  # will want more than that.
  if {$itk_option(-defaultringpad) < 0 || $itk_option(-defaultringpad) > 20} {
    error "Value for -defaultringpad must be between 0 and 20."
  }

  # If the ring is displayed, repack it according to the new padding amount.
  if {$itk_option(-defaultring)} {
    pack $itk_component(reliefframe) -padx $itk_option(-defaultringpad) \
      -pady $itk_option(-defaultringpad)
  }
}


#-------------------------------------------------------------------------------
# OPTION: -image
#
# DESCRIPTION: This isn't a new option - we just need to repack the frame after
#   the image is changed in case the size is different than the previous one.
#   This option is kept by the image component.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::image {
  pack $itk_component(frame) -padx 4 -pady 4
}


#-------------------------------------------------------------------------------
# OPTION: -imagepos
#
# DESCRIPTION: Allows the user to move the image to different locations areound
#   the text.  Valid options are n, nw, ne, s, sw, se e, en, es, w, wn or ws.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::imagepos {
  switch -- $itk_option(-imagepos) {
    n  {set side top;    set anchor center}
    ne {set side top;    set anchor e}
    nw {set side top;    set anchor w}

    s  {set side bottom; set anchor center}
    se {set side bottom; set anchor e}
    sw {set side bottom; set anchor w}

    w  {set side left;   set anchor center}
    wn {set side left;   set anchor n}
    ws {set side left;   set anchor s}

    e  {set side right;  set anchor center}
    en {set side right;  set anchor n}
    es {set side right;  set anchor s}

    default {
      error "Invalid option: \"$itk_option(-imagepos)\". \
             Must be n, nw, ne, s, sw, se e, en, es, w, wn or ws."
    }
  }

  pack $itk_component(image) -side $side -anchor $anchor
  pack $itk_component(frame) -padx 4 -pady 4
}


#-------------------------------------------------------------------------------
# OPTION: -relief
#
# DESCRIPTION: Move the frame component according to the relief to simulate
#   the text in a Tk button when its relief is changed.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::relief {
  update idletasks
  switch -- $itk_option(-relief) {
    flat - ridge - groove {
      place $itk_component(frame) -x 5 -y 5
    }

    raised {
      place $itk_component(frame) -x 4 -y 4
    }

    sunken {
      place $itk_component(frame) -x 6 -y 6
    }

    default {
      error "Invalid option: \"$itk_option(-relief)\".  \
             Must be flat, ridge, groove, raised, or sunken."
    }
  }
}


#-------------------------------------------------------------------------------
# OPTION: -state
#
# DESCRIPTION: Simulate the button's -state option.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::state {
  switch -- $itk_option(-state) {
    disabled {
      bind $itk_interior <Enter> { }
      bind $itk_interior <Leave> { }
      bind $this-sunkentag <1> { }
      bind $this-raisedtag <ButtonRelease-1> { }
      bind $this-commandtag <ButtonRelease-1> { }
      set _oldValues(-fg) [cget -foreground]
      set _oldValues(-cursor) [cget -cursor]
      configure -foreground $itk_option(-disabledforeground)
      configure -cursor "X_cursor red black"
    }

    normal {
      bind $itk_interior <Enter> [itcl::code $this changeColor enter]
      bind $itk_interior <Leave> [itcl::code $this changeColor leave]
      bind $this-sunkentag <1> [itcl::code $this sink]
      bind $this-raisedtag <ButtonRelease-1> [itcl::code $this raise]
      bind $this-commandtag <ButtonRelease-1> [itcl::code $this invoke]
      configure -foreground $_oldValues(-fg)
      configure -cursor $_oldValues(-cursor)
    }

    default {
      error "Bad option for -state: \"$itk_option(-state)\".  Should be\
	normal or disabled."
    }
  }
}


#-------------------------------------------------------------------------------
# OPTION: -text
#
# DESCRIPTION: This isn't a new option.  Similar to -image, we just need to
#   repack the frame when the text changes.   
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::text {
  pack $itk_component(frame) -padx 4 -pady 4
}



#-------------------------------------------------------------------------------
#                                CONSTRUCTOR
#-------------------------------------------------------------------------------
itcl::body iwidgets::Extbutton::constructor {args} {
  # Extbutton will not work with versions of Tk less than 8.4 (the
  # -activeforeground option was added to the Tk label widget in 8.4, for
  # example).  So disallow its use unless the right wish is being used.
  if {$::tk_version < 8.4} {
    error "The extbutton \[incr Widget\] can only be used with versions of\
      Tk greater than 8.3.\nYou're currently using version $::tk_version."
  }

  # This frame is optionally displayed as a "default ring" around the button.
  itk_component add ring {
    frame $itk_interior.ring -relief sunken
  } {
    rename -background -ringbackground ringBackground Background
  }

  # Add an outer frame for the widget's relief.  Ideally we could just keep
  # the hull's -relief, but it's too tricky to handle relief changes.
  itk_component add -private reliefframe {
    frame $itk_component(ring).f
  } {
    rename -borderwidth -bd borderwidth BorderWidth
    keep -relief
    usual
  }

  # This frame contains the image and text.  It will be moved slightly to
  # simulate the text in a Tk button when the button is depressed/raised.
  itk_component add frame {
    frame $itk_component(reliefframe).f -borderwidth 0
  }

  itk_component add image {
    label $itk_component(frame).img -borderwidth 0
  } {
    keep -bitmap -background -image
    rename -foreground -bitmapforeground foreground Foreground
  }

  itk_component add label {
    label $itk_component(frame).txt -borderwidth 0
  } {
    keep -activeforeground -background -disabledforeground
    keep -font -foreground -justify -text
  }

  pack $itk_component(image) $itk_component(label) -side left -padx 6 -pady 4
  pack $itk_component(frame) -padx 4 -pady 4
  pack $itk_component(reliefframe) -fill both
  pack $itk_component(ring) -fill both

  # Create a couple of binding tags for handling relief changes.  Then
  # add these tags to each component.
  foreach component [component] {
    bindtags [component $component] \
      [linsert [bindtags [component $component]] end $this-sunkentag]
    bindtags [component $component] \
      [linsert [bindtags [component $component]] end $this-raisedtag]
  }

  set _oldValues(-fg) [cget -foreground]
  set _oldValues(-cursor) [cget -cursor]

  eval itk_initialize $args
}


#-------------------------------------------------------------------------------
# METHOD: flash
#
# ACCESS: public
#
# DESCRIPTION: Simulate the Tk button flash command.
#
# ARGUMENTS: none
#-------------------------------------------------------------------------------
itcl::body iwidgets::Extbutton::flash {} {
  set oldbg [cget -background]
  config -background $itk_option(-activebackground)
  update idletasks

  after 50; config -background $oldbg; update idletasks
  after 50; config -background $itk_option(-activebackground); update idletasks
  after 50; config -background $oldbg
}


#-------------------------------------------------------------------------------
# METHOD: changeColor
#
# ACCESS: private
#
# DESCRIPTION: This method is invoked by <Enter> and <Leave> events to change
#   the background and foreground colors of the widget.
#
# ARGUMENTS: event_ --> either "enter" or "leave"
#-------------------------------------------------------------------------------
itcl::body iwidgets::Extbutton::changeColor {event_} {
  switch -- $event_ {
    enter {
      set _oldValues(-bg) [cget -background]
      set _oldValues(-fg) [cget -foreground]
      configure -background $itk_option(-activebackground)
      configure -foreground $itk_option(-activeforeground)
    }
    leave {
      configure -background $_oldValues(-bg)
      configure -foreground $_oldValues(-fg)
    }
  }
}


#-------------------------------------------------------------------------------
# METHOD: sink
#
# ACCESS: private
#
# DESCRIPTION: This method is invoked on <1> mouse events.  It saves the
#   current relief for later restoral and configures the relief to sunken if
#   it isn't already sunken.
#
# ARGUMENTS: none
#-------------------------------------------------------------------------------
itcl::body iwidgets::Extbutton::sink {} {
  set _oldValues(-relief) [cget -relief]
  if {$_oldValues(-relief) == "sunken"} {
    return
  }
  configure -relief sunken
}

Added library/extfileselectionbox.itk.







































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
#
# Extfileselectionbox
# ----------------------------------------------------------------------
# Implements a file selection box that is a slightly extended version
# of the OSF/Motif standard XmExtfileselectionbox composite widget.  
# The Extfileselectionbox differs from the Motif standard in that the
# filter and selection fields are comboboxes and the files and directory
# lists are in a paned window.
#
# ----------------------------------------------------------------------
#  AUTHOR: Mark L. Ulferts               EMAIL: mulferts@spd.dsccc.com
#          Anthony L. Parent                    tony.parent@symbios.com
#
#  @(#) $Id: extfileselectionbox.itk,v 1.6 2006/04/11 19:50:38 hobbs Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1997 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software
# and its documentation for any purpose, and without fee or written
# agreement with DSC, is hereby granted, provided that the above copyright
# notice appears in all copies and that both the copyright notice and
# warranty disclaimer below appear in supporting documentation, and that
# the names of DSC Technologies Corporation or DSC Communications
# Corporation not be used in advertising or publicity pertaining to the
# software without specific, written prior permission.
#
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Extfileselectionbox {
    keep -activebackground -activerelief -background -borderwidth -cursor \
         -elementborderwidth -foreground -highlightcolor -highlightthickness \
         -insertbackground -insertborderwidth -insertofftime -insertontime \
         -insertwidth -jump -labelfont -selectbackground -selectborderwidth \
         -textbackground -textfont -troughcolor
}

# ------------------------------------------------------------------
#                          EXTFILESELECTIONBOX
# ------------------------------------------------------------------
itcl::class iwidgets::Extfileselectionbox {
    inherit itk::Widget

    constructor {args} {}
    destructor {}

    itk_option define -childsitepos childSitePos Position s
    itk_option define -fileson filesOn FilesOn true
    itk_option define -dirson dirsOn DirsOn true
    itk_option define -selectionon selectionOn SelectionOn true
    itk_option define -filteron filterOn FilterOn true
    itk_option define -mask mask Mask {*}
    itk_option define -directory directory Directory {}
    itk_option define -automount automount Automount {}
    itk_option define -nomatchstring noMatchString NoMatchString {}
    itk_option define -dirsearchcommand dirSearchCommand Command {}
    itk_option define -filesearchcommand fileSearchCommand Command {}
    itk_option define -selectioncommand selectionCommand Command {}
    itk_option define -filtercommand filterCommand Command {}
    itk_option define -selectdircommand selectDirCommand Command {}
    itk_option define -selectfilecommand selectFileCommand Command {}
    itk_option define -invalid invalid Command {bell}
    itk_option define -filetype fileType FileType {regular}
    itk_option define -width width Width 350
    itk_option define -height height Height 300

    public {
    method childsite {}
    method get {}
    method filter {}
    }

    protected {
    method _packComponents {{when later}}
    method _updateLists {{when later}}
    }

    private {
    method _selectDir {}
    method _dblSelectDir {}
    method _selectFile {}
    method _selectSelection {}
    method _selectFilter {}
    method _setFilter {}
    method _setSelection {}
    method _setDirList {}
    method _setFileList {}

    method _nPos {}
    method _sPos {}
    method _ePos {}
    method _wPos {}
    method _topPos {}
    method _bottomPos {}

    variable _packToken ""      ;# non-null => _packComponents pending
    variable _updateToken ""    ;# non-null => _updateLists pending
    variable _pwd "."           ;# present working dir
    variable _interior          ;# original interior setting
    }
}

#
# Provide a lowercased access method for the Extfileselectionbox class.
#
proc ::iwidgets::extfileselectionbox {pathName args} {
    uplevel ::iwidgets::Extfileselectionbox $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *Extfileselectionbox.borderWidth 2 widgetDefault

option add *Extfileselectionbox.filterLabel Filter widgetDefault
option add *Extfileselectionbox.dirsLabel Directories widgetDefault
option add *Extfileselectionbox.filesLabel Files widgetDefault
option add *Extfileselectionbox.selectionLabel Selection widgetDefault

option add *Extfileselectionbox.width 350 widgetDefault
option add *Extfileselectionbox.height 300 widgetDefault

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::constructor {args} {
    #
    # Add back to the hull width and height options and make the
    # borderwidth zero since we don't need it.
    #
    itk_option add hull.width hull.height
    component hull configure -borderwidth 0

    set _interior $itk_interior

    #
    # Create the filter entry.
    #
    itk_component add filter {
        iwidgets::Combobox $itk_interior.filter -unique true \
        -command [itcl::code $this _selectFilter] -exportselection 0 \
        -labelpos nw -completion 0
    
    } {
    usual

        rename -labeltext -filterlabel filterLabel Text
    }

    set cmd [$itk_component(filter) cget -command]
    set cmd "$cmd;[itcl::code $this _selectFilter]"
    $itk_component(filter) configure -command "$cmd" -selectioncommand "$cmd";

    #
    # Create a paned window for the directory and file lists.
    #
    itk_component add listpane {
        iwidgets::Panedwindow $itk_interior.listpane -orient vertical
    } 

    $itk_component(listpane) add dirs -margin 5
    $itk_component(listpane) add files -margin 5

    #
    # Create the directory list.
    #
    itk_component add dirs {
        iwidgets::Scrolledlistbox [$itk_component(listpane) childsite dirs].dirs \
        -selectioncommand [itcl::code $this _selectDir] \
        -selectmode single -exportselection 0 \
        -visibleitems 1x1 -labelpos nw \
        -hscrollmode static -vscrollmode static \
        -dblclickcommand [itcl::code $this _dblSelectDir]
    } {
    usual

        rename -labeltext -dirslabel dirsLabel Text
    }
    grid $itk_component(dirs) -sticky nsew
    grid rowconfigure [$itk_component(listpane) childsite dirs] 0 -weight 1
    grid columnconfigure [$itk_component(listpane) childsite dirs] 0 -weight 1

    #
    # Create the files list.
    #
    itk_component add files {
        iwidgets::Scrolledlistbox [$itk_component(listpane) childsite files].files \
        -selectioncommand [itcl::code $this _selectFile] \
        -selectmode single -exportselection 0 \
        -visibleitems 1x1 -labelpos nw \
        -hscrollmode static -vscrollmode static
    } {
    usual

        rename -labeltext -fileslabel filesLabel Text
    }
    grid $itk_component(files) -sticky nsew
    grid rowconfigure [$itk_component(listpane) childsite files] 0 -weight 1
    grid columnconfigure [$itk_component(listpane) childsite files] 0 -weight 1

    #
    # Create the selection entry.
    #
    itk_component add selection {
      iwidgets::Combobox $itk_interior.selection -unique true \
      -command [itcl::code $this _selectSelection] -exportselection 0 \
      -labelpos nw -completion 0
    } {
    usual

        rename -labeltext -selectionlabel selectionLabel Text
    }

    #
    # Create the child site widget.
    #
    itk_component add -protected childsite {
        frame $itk_interior.fsbchildsite
    } 

    #
    # Set the interior variable to the childsite for derived classes.
    #
    set itk_interior $itk_component(childsite)

    #
    # Explicitly handle configs that may have been ignored earlier.
    #
    eval itk_initialize $args

    #
    # When idle, pack the childsite and update the lists.
    #
    _packComponents
    _updateLists
}

# ------------------------------------------------------------------
#                           DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::destructor {} {
    if {$_packToken != ""} {after cancel $_packToken}
    if {$_updateToken != ""} {after cancel $_updateToken}
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -childsitepos
#
# Specifies the position of the child site in the selection box.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::childsitepos {
    _packComponents
}

# ------------------------------------------------------------------
# OPTION: -fileson
#
# Specifies whether or not to display the files list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::fileson {
    if {$itk_option(-fileson)} {
        $itk_component(listpane) show files

        _updateLists

    } else {
        $itk_component(listpane) hide files
    }
}

# ------------------------------------------------------------------
# OPTION: -dirson
#
# Specifies whether or not to display the dirs list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::dirson {
    if {$itk_option(-dirson)} {
        $itk_component(listpane) show dirs

        _updateLists

    } else {
        $itk_component(listpane) hide dirs
    }
}

# ------------------------------------------------------------------
# OPTION: -selectionon
#
# Specifies whether or not to display the selection entry widget.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::selectionon {
    _packComponents
}

# ------------------------------------------------------------------
# OPTION: -filteron
#
# Specifies whether or not to display the filter entry widget.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::filteron {
    _packComponents
}

# ------------------------------------------------------------------
# OPTION: -mask
#
# Specifies the initial file mask string.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::mask {
    global tcl_platform
    set prefix $_pwd

    #
    # Remove automounter paths.
    #
    if {$tcl_platform(platform) == "unix"} {
        if {$itk_option(-automount) != {}} {
            foreach autoDir $itk_option(-automount) {
                # Use catch because we can't be sure exactly what strings
                # were passed into the -automount option
                catch {
                    if {[regsub ^/$autoDir $prefix {} prefix] != 0} {
                        break
                    }
                }
            }
        }
    }

    set curFilter $itk_option(-mask);
    $itk_component(filter) delete entry 0 end
    $itk_component(filter) insert entry 0 [file join "$_pwd" $itk_option(-mask)]

    #
    # Make sure the right most text is visable.
    #
    [$itk_component(filter) component entry] xview moveto 1
}

# ------------------------------------------------------------------
# OPTION: -directory
#
# Specifies the initial default directory.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::directory {
    if {$itk_option(-directory) != {}} {
        if {! [file exists $itk_option(-directory)]} {
            error "bad directory option \"$itk_option(-directory)\":\
                    directory does not exist"
        }

        set olddir [pwd]
        cd $itk_option(-directory)
        set _pwd [pwd]
        cd $olddir

        configure -mask $itk_option(-mask)
        _selectFilter
    }
}

# ------------------------------------------------------------------
# OPTION: -automount
#
# Specifies list of directory prefixes to ignore. Typically, this
# option would be used with values such as:
#   -automount {export tmp_mnt}
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::automount {
}

# ------------------------------------------------------------------
# OPTION: -nomatchstring
#
# Specifies the string to be displayed in the files list should
# not regular files exist in the directory.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::nomatchstring {
}

# ------------------------------------------------------------------
# OPTION: -dirsearchcommand
#
# Specifies a command to be executed to perform a directory search.
# The command will receive the current working directory and filter
# mask as arguments.  The command should return a list of files which
# will be placed into the directory list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::dirsearchcommand {
}

# ------------------------------------------------------------------
# OPTION: -filesearchcommand
#
# Specifies a command to be executed to perform a file search.
# The command will receive the current working directory and filter
# mask as arguments.  The command should return a list of files which
# will be placed into the file list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::filesearchcommand {
}

# ------------------------------------------------------------------
# OPTION: -selectioncommand
#
# Specifies a command to be executed upon pressing return in the
# selection entry widget.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::selectioncommand {
}

# ------------------------------------------------------------------
# OPTION: -filtercommand
#
# Specifies a command to be executed upon pressing return in the
# filter entry widget.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::filtercommand {
}

# ------------------------------------------------------------------
# OPTION: -selectdircommand
#
# Specifies a command to be executed following selection of a
# directory in the directory list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::selectdircommand {
}

# ------------------------------------------------------------------
# OPTION: -selectfilecommand
#
# Specifies a command to be executed following selection of a
# file in the files list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::selectfilecommand {
}

# ------------------------------------------------------------------
# OPTION: -invalid
#
# Specify a command to executed should the filter contents be
# proven invalid.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::invalid {
}

# ------------------------------------------------------------------
# OPTION: -filetype
#
# Specify the type of files which may appear in the file list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::filetype {
    switch $itk_option(-filetype) {
        regular -
        directory -
        any {
        }
        default {
            error "bad filetype option \"$itk_option(-filetype)\":\
                    should be regular, directory, or any"
        }
    }

    _updateLists
}

# ------------------------------------------------------------------
# OPTION: -width
#
# Specifies the width of the file selection box.  The value may be
# specified in any of the forms acceptable to Tk_GetPixels.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::width {
    #
    # The width option was added to the hull in the constructor.
    # So, any width value given is passed automatically to the
    # hull.  All we have to do is play with the propagation.
    #
    if {$itk_option(-width) != 0} {
        set propagate 0
    } else {
        set propagate 1
    }

    #
    # Due to a bug in the tk4.2 grid, we have to check the 
    # propagation before setting it.  Setting it to the same
    # value it already is will cause it to toggle.
    #
    if {[grid propagate $itk_component(hull)] != $propagate} {
        grid propagate $itk_component(hull) $propagate
    }
}

# ------------------------------------------------------------------
# OPTION: -height
#
# Specifies the height of the file selection box.  The value may be
# specified in any of the forms acceptable to Tk_GetPixels.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Extfileselectionbox::height {
    #
    # The height option was added to the hull in the constructor.
    # So, any height value given is passed automatically to the
    # hull.  All we have to do is play with the propagation.
    #
    if {$itk_option(-height) != 0} {
        set propagate 0
    } else {
        set propagate 1
    }

    #
    # Due to a bug in the tk4.2 grid, we have to check the 
    # propagation before setting it.  Setting it to the same
    # value it already is will cause it to toggle.
    #
    if {[grid propagate $itk_component(hull)] != $propagate} {
        grid propagate $itk_component(hull) $propagate
    }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: childsite
#
# Returns the path name of the child site widget.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::childsite {} {
    return $itk_component(childsite)
}

# ------------------------------------------------------------------
# METHOD: get
#
# Returns the current selection.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::get {} {
    return [$itk_component(selection) get]
}

# ------------------------------------------------------------------
# METHOD: filter
#
# The user has pressed Return in the filter.  Make sure the contents
# contain a valid directory before setting default to directory.
# Use the invalid option to warn the user of any problems.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::filter {} {
    set newdir [file dirname [$itk_component(filter) get]]

    if {! [file exists $newdir]} {
        uplevel #0 "$itk_option(-invalid)"
        return
    }

    set _pwd $newdir;
    if {$_pwd == "."} {set _pwd [pwd]};

    _updateLists
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _updateLists ?now?
#
# Updates the contents of both the file and directory lists, as well
# resets the positions of the filter, and lists.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_updateLists {{when "later"}} {
    switch -- $when {
        later {
            if {$_updateToken == ""} {
                set _updateToken [after idle [itcl::code $this _updateLists now]]
            }
        }
        now {
            if {$itk_option(-dirson)} {_setDirList}
            if {$itk_option(-fileson)} {_setFileList}

            if {$itk_option(-filteron)} {
                _setFilter
            }
            if {$itk_option(-selectionon)} {
                $itk_component(selection) icursor end
            }
            if {$itk_option(-dirson)} {
                $itk_component(dirs) justify left
            }
            if {$itk_option(-fileson)} {
                $itk_component(files) justify left
            }
            set _updateToken ""
        }
        default {
            error "bad option \"$when\": should be later or now"
        }
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _setFilter
#
# Set the filter to the current selection in the directory list plus
# any existing mask in the filter.  Translate the two special cases
# of '.', and '..' directory names to full path names..
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_setFilter {} {
    global tcl_platform
    set prefix [$itk_component(dirs) getcurselection]
    set curFilter [file tail [$itk_component(filter) get]]

    while {[regexp {\.$} $prefix]} {
        if {[file tail $prefix] == "."} {
            if {$prefix == "."} {
                if {$_pwd == "."} {
                    set _pwd [pwd]
                } elseif {$_pwd == ".."} {
                    set _pwd [file dirname [pwd]]
                }
                set prefix $_pwd
            } else {
                set prefix [file dirname $prefix]
            }
        } elseif {[file tail $prefix] == ".."} {
            if {$prefix != ".."} {
                set prefix [file dirname [file dirname $prefix]]
            } else {
                if {$_pwd == "."} {
                    set _pwd [pwd]
                } elseif {$_pwd == ".."} {
                    set _pwd [file dirname [pwd]]
                }
                set prefix [file dirname "$_pwd"]
            }
        } else {
            break
        }
    }

    if { [file pathtype $prefix] != "absolute" } {
        set prefix [file join "$_pwd" $prefix]
    }

    #
    # Remove automounter paths.
    #
    if {$tcl_platform(platform) == "unix"} {
        if {$itk_option(-automount) != {}} {
            foreach autoDir $itk_option(-automount) {
                # Use catch because we can't be sure exactly what strings
                # were passed into the -automount option
                catch {
                    if {[regsub ^/$autoDir $prefix {} prefix] != 0} {
                        break
                    }
                }
            }
        }
    }

    $itk_component(filter) delete entry 0 end
    $itk_component(filter) insert entry 0 [file join $prefix $curFilter]

    if {[info level -1] != "_selectDir"} {
        $itk_component(filter) insert list 0 [file join $prefix $curFilter]
    }

    #
    # Make sure insertion cursor is at the end.
    #
    $itk_component(filter) icursor end

    #
    # Make sure the right most text is visable.
    #
    [$itk_component(filter) component entry] xview moveto 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _setSelection
#
# Set the contents of the selection entry to either the current
# selection of the file or directory list dependent on which lists
# are currently mapped.  For the file list, avoid seleciton of the
# no match string.  As for the directory list, translate file names.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_setSelection {} {
    global tcl_platform
    $itk_component(selection) delete entry 0 end

    if {$itk_option(-fileson)} {
        set selection [$itk_component(files) getcurselection]

        if {$selection != $itk_option(-nomatchstring)} {
            if {[file pathtype $selection] != "absolute"} {
                set selection [file join "$_pwd" $selection]
            }

        #
        # Remove automounter paths.
        #
        if {$tcl_platform(platform) == "unix"} {
            if {$itk_option(-automount) != {}} {
                foreach autoDir $itk_option(-automount) {
                    # Use catch because we can't be sure exactly what strings
                    # were passed into the -automount option
                    catch {
                        if {[regsub ^/$autoDir $selection {} selection] != 0} {
                            break
                        }
                    }
                }
            }
        }

        $itk_component(selection) insert entry 0 $selection
        } else {
            $itk_component(files) selection clear 0 end
    }

    } else {
        set selection [$itk_component(dirs) getcurselection]

    if {[file tail $selection] == "."} {
        if {$selection != "."} {
            set selection [file dirname $selection]
        } else {
            set selection "$_pwd"
        }
    } elseif {[file tail $selection] == ".."} {
        if {$selection != ".."} {
            set selection [file dirname [file dirname $selection]]
        } else {
            set selection [file join "$_pwd" ..]
        }
    } else {
        set selection [file join "$_pwd" $selection]
    }

    #
        # Remove automounter paths.
    #
    if {$tcl_platform(platform) == "unix"} {
        if {$itk_option(-automount) != {}} {
            foreach autoDir $itk_option(-automount) {
                # Use catch because we can't be sure exactly what strings
                # were passed into the -automount option
                catch {
                    if {[regsub ^/$autoDir $selection {} selection] != 0} {
                        break
                    }
                }
            }
        }
    }

        $itk_component(selection) insert entry 0 $selection
    }

    $itk_component(selection) insert list 0 $selection
    $itk_component(selection) icursor end

    #
    # Make sure the right most text is visable.
    #
    [$itk_component(selection) component entry] xview moveto 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _setDirList
#
# Clear the directory list and dependent on whether the user has
# defined their own search procedure or not fill the list with their
# results or those of a glob.  Select the first element if it exists.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_setDirList {} {
    $itk_component(dirs) clear

    set currentIndex ""
    if {$itk_option(-dirsearchcommand) == {}} {
        set cwd "$_pwd"
        
        set counter 0
        foreach i [lsort [glob -nocomplain \
                  [file join $cwd .*] [file join $cwd *]]] {
            if {[file isdirectory $i]} {
                set insert "[file tail $i]"
                if {$insert == "."} {
                    set currentIndex $counter
                }
                $itk_component(dirs) insert end "$insert"
                incr counter
            }
        }

    } else {
        set mask [file tail [$itk_component(filter) get]]

        foreach file [uplevel #0 $itk_option(-dirsearchcommand) "$_pwd" $mask] {
            $itk_component(dirs) insert end $file
        }
    }

    if {[$itk_component(dirs) size]} {
        $itk_component(dirs) selection clear 0 end
        if {$currentIndex != ""} {
            $itk_component(dirs) selection set $currentIndex
        } else {
            $itk_component(dirs) selection set 0
        }
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _setFileList
#
# Clear the file list and dependent on whether the user has defined
# their own search procedure or not fill the list with their results
# or those of a 'glob'.  If the files list has no contents, then set
# the files list to the 'nomatchstring'.  Clear all selections.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_setFileList {} {
    $itk_component(files) clear
    set mask [file tail [$itk_component(filter) get]]

    if {$itk_option(-filesearchcommand) == {}} {
        if {$mask == "*"} {
            set files [lsort [glob -nocomplain \
                  [file join "$_pwd" .*] [file join "$_pwd" *]]]
        } else {
            set files [lsort [glob -nocomplain [file join "$_pwd" $mask]]]
        }

        foreach i $files {
            if {($itk_option(-filetype) == "regular" && \
            ! [file isdirectory $i]) || \
            ($itk_option(-filetype) == "directory" && \
            [file isdirectory $i]) || \
            ($itk_option(-filetype) == "any")} {
        set insert "[file tail $i]"
        $itk_component(files) insert end "$insert"
            }
        }

    } else {
        foreach file [uplevel #0 $itk_option(-filesearchcommand) "$_pwd" $mask] {
            $itk_component(files) insert end $file
        }
    }

    if {[$itk_component(files) size] == 0} {
        if {$itk_option(-nomatchstring) != {}} {
            $itk_component(files) insert end $itk_option(-nomatchstring)
        }
    }

    $itk_component(files) selection clear 0 end
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _selectDir
#
# For a selection in the directory list, set the filter and possibly
# the selection entry based on the fileson option.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_selectDir {} {
    _setFilter

    if {$itk_option(-fileson)} {} {
        _setSelection
    }

    if {$itk_option(-selectdircommand) != {}} {
        uplevel #0 $itk_option(-selectdircommand)
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _dblSelectDir
#
# For a double click event in the directory list, select the
# directory, set the default to the selection, and update both the
# file and directory lists.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_dblSelectDir {} {
    filter
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _selectFile
#
# The user has selected a file.  Put the current selection in the
# file list in the selection entry widget.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_selectFile {} {
    _setSelection

    if {$itk_option(-selectfilecommand) != {}} {
        uplevel #0 $itk_option(-selectfilecommand)
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _selectSelection
#
# The user has pressed Return in the selection entry widget.  Call
# the defined selection command if it exists.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_selectSelection {} {
    if {$itk_option(-selectioncommand) != {}} {
        uplevel #0 $itk_option(-selectioncommand)
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _selectFilter
#
# The user has pressed Return in the filter entry widget.  Call the
# defined selection command if it exists, otherwise just filter.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_selectFilter {} {
    if {$itk_option(-filtercommand) != {}} {
        uplevel #0 $itk_option(-filtercommand)
    } else {
        filter
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _packComponents
#
# Pack the selection, items, and child site widgets based on options.
# Using the -in option of pack, put the childsite around the frame
# in the hull for n, s, e, and w positions.  Make sure and raise 
# the child site since using the 'in' option may obscure the site.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_packComponents {{when "later"}} {
    if {$when == "later"} {
        if {$_packToken == ""} {
            set _packToken [after idle [itcl::code $this _packComponents now]]
        }
        return
    } elseif {$when != "now"} {
        error "bad option \"$when\": should be now or later"
    }

    set _packToken ""

    #
    # Forget about any previous placements via the grid and
    # reset all the possible minsizes and weights for all
    # the rows and columns.
    #
    foreach component {childsite listpane filter selection} {
        grid forget $itk_component($component)
    }

    for {set row 0} {$row < 6} {incr row} {
        grid rowconfigure $_interior $row -minsize 0 -weight 0
    }

    for {set col 0} {$col < 3} {incr col} {
        grid columnconfigure $_interior $col -minsize 0 -weight 0
    }

    #
    # Place all the components based on the childsite poisition
    # option.
    #
    switch $itk_option(-childsitepos) {
        n { _nPos }

        w { _wPos }

        s { _sPos }

        e { _ePos }

    top { _topPos }

    bottom { _bottomPos }

        default {
            error "bad childsitepos option \"$itk_option(-childsitepos)\":\
                    should be n, e, s, w, top, or bottom"
        }
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _nPos
#
# Position the childsite to the north and all the other components
# appropriately based on the individual "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_nPos {} {
    grid $itk_component(childsite) -row 0 -column 0 \
    -columnspan 1 -rowspan 1 -sticky nsew -padx 5

    if {$itk_option(-filteron)} {
        grid $itk_component(filter) -row 1 -column 0 \
            -columnspan 1 -sticky ew -padx 5
        grid rowconfigure $_interior 2 -minsize 7
    }

    grid $itk_component(listpane) -row 3 -column 0 \
        -columnspan 1 -sticky nsew

    grid rowconfigure $_interior 3 -weight 1

    if {$itk_option(-selectionon)} {
        grid rowconfigure $_interior 4 -minsize 7
        grid $itk_component(selection) -row 5 -column 0 \
            -columnspan 1 -sticky ew -padx 5
    }

    grid columnconfigure $_interior 0 -weight 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _sPos
#
# Position the childsite to the south and all the other components
# appropriately based on the individual "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_sPos {} {
    if {$itk_option(-filteron)} {
        grid $itk_component(filter) -row 0 -column 0 \
            -columnspan 1 -sticky ew -padx 5
        grid rowconfigure $_interior 1 -minsize 7
    }

    grid $itk_component(listpane) -row 2 -column 0 \
        -columnspan 1 -sticky nsew
    
    grid rowconfigure $_interior 2 -weight 1

    if {$itk_option(-selectionon)} {
        grid rowconfigure $_interior 3 -minsize 7
        grid $itk_component(selection) -row 4 -column 0 \
            -columnspan 1 -sticky ew -padx 5
    }
    
    grid $itk_component(childsite) -row 5 -column 0 \
    -columnspan 1 -rowspan 1 -sticky nsew -padx 5

    grid columnconfigure $_interior 0 -weight 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _ePos
#
# Position the childsite to the east and all the other components
# appropriately based on the individual "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_ePos {} {
    if {$itk_option(-filteron)} {
        grid $itk_component(filter) -row 0 -column 0 \
            -columnspan 1 -sticky ew -padx 5
        grid rowconfigure $_interior 1 -minsize 7
    }

    grid $itk_component(listpane) -row 2 -column 0 \
        -columnspan 1 -sticky nsew

    grid rowconfigure $_interior 2 -weight 1

    if {$itk_option(-selectionon)} {
        grid rowconfigure $_interior 3 -minsize 7
        grid $itk_component(selection) -row 4 -column 0 \
            -columnspan 1 -sticky ew -padx 5
    }

    grid $itk_component(childsite) -row 0 -column 1 \
    -rowspan 5 -columnspan 1 -sticky nsew

    grid columnconfigure $_interior 0 -weight 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _wPos
#
# Position the childsite to the west and all the other components
# appropriately based on the individual "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_wPos {} {
    grid $itk_component(childsite) -row 0 -column 0 \
    -rowspan 5 -columnspan 1 -sticky nsew

    if {$itk_option(-filteron)} {
        grid $itk_component(filter) -row 0 -column 1 \
            -columnspan 1 -sticky ew -padx 5
        grid rowconfigure $_interior 1 -minsize 7
    } 

    grid $itk_component(listpane) -row 2 -column 1 \
        -columnspan 1 -sticky nsew

    grid rowconfigure $_interior 2 -weight 1

    if {$itk_option(-selectionon)} {
        grid rowconfigure $_interior 3 -minsize 7
        grid $itk_component(selection) -row 4 -column 1 \
            -columnspan 1 -sticky ew -padx 5
    }

    grid columnconfigure $_interior 1 -weight 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _topPos
#
# Position the childsite below the filter but above the lists and 
# all the other components appropriately based on the individual 
# "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_topPos {} {
    if {$itk_option(-filteron)} {
        grid $itk_component(filter) -row 0 -column 0 \
            -columnspan 1 -sticky ew -padx 5
    }

    grid $itk_component(childsite) -row 1 -column 0 \
    -columnspan 1 -rowspan 1 -sticky nsew -padx 5

    grid $itk_component(listpane) -row 2 -column 0 -sticky nsew

    grid rowconfigure $_interior 2 -weight 1

    if {$itk_option(-selectionon)} {
        grid rowconfigure $_interior 3 -minsize 7
        grid $itk_component(selection) -row 4 -column 0 \
            -columnspan 1 -sticky ew -padx 5
    }

    grid columnconfigure $_interior 0 -weight 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _bottomPos
#
# Position the childsite below the lists and above the selection
# and all the other components appropriately based on the individual 
# "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_bottomPos {} {
    if {$itk_option(-filteron)} {
        grid $itk_component(filter) -row 0 -column 0 \
            -columnspan 1 -sticky ew -padx 5
        grid rowconfigure $_interior 1 -minsize 7
    }

    grid $itk_component(listpane) -row 2 -column 0 -sticky nsew

    grid rowconfigure $_interior 2 -weight 1

    grid $itk_component(childsite) -row 3 -column 0 \
    -columnspan 1 -rowspan 1 -sticky nsew -padx 5

    if {$itk_option(-selectionon)} {
        grid $itk_component(selection) -row 4 -column 0 \
            -columnspan 1 -sticky ew -padx 5
    }

    grid columnconfigure $_interior 0 -weight 1
}

Added library/extfileselectiondialog.itk.













































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#
# Extfileselectiondialog
# ----------------------------------------------------------------------
# Implements a file selection dialog that is a slightly extended version
# of the OSF/Motif standard composite widget.  The Extfileselectionbox 
# differs from the Motif standard in that the filter and selection 
# fields are comboboxes and the files and directory lists are in a 
# paned window.
# 
# ----------------------------------------------------------------------
#  AUTHOR: Mark L. Ulferts               EMAIL: mulferts@spd.dsccc.com
#
#  @(#) $Id: extfileselectiondialog.itk,v 1.3 2002/02/27 06:45:10 mgbacke Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1997 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Extfileselectiondialog {
    keep -activebackground -activerelief -background -borderwidth -cursor \
     -elementborderwidth -foreground -highlightcolor -highlightthickness \
     -insertbackground -insertborderwidth -insertofftime -insertontime \
     -insertwidth -jump -labelfont -modality -selectbackground \
     -selectborderwidth -textbackground -textfont 
}

# ------------------------------------------------------------------
#                        EXTFILESELECTIONDIALOG
# ------------------------------------------------------------------
itcl::class iwidgets::Extfileselectiondialog {
    inherit iwidgets::Dialog

    constructor {args} {}

    public {
    method childsite {}
    method get {}
    method filter {}
    }

    protected method _dbldir {}
}

#
# Provide a lowercased access method for the Extfileselectiondialog class.
# 
proc ::iwidgets::extfileselectiondialog {pathName args} {
    uplevel ::iwidgets::Extfileselectiondialog $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *Extfileselectiondialog.borderWidth 2 widgetDefault

option add *Extfileselectiondialog.title "File Selection Dialog" widgetDefault

option add *Extfileselectiondialog.width 350 widgetDefault
option add *Extfileselectiondialog.height 400 widgetDefault

option add *Extfileselectiondialog.master "." widgetDefault

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectiondialog::constructor {args} {
    component hull configure -borderwidth 0
    itk_option add hull.width hull.height
    
    #
    # Turn off pack propagation for the hull widget so the width
    # and height options become active.
    #
    pack propagate $itk_component(hull) no
    
    # 
    # Instantiate a file selection box widget.
    #
    itk_component add fsb {
    iwidgets::Extfileselectionbox $itk_interior.fsb -width 150 -height 150 \
        -selectioncommand [itcl::code $this invoke] \
            -selectdircommand [itcl::code $this default Apply] \
            -selectfilecommand [itcl::code $this default OK]
    } {
    usual

    keep -labelfont -childsitepos -directory -dirslabel \
        -dirsearchcommand -dirson -fileslabel -fileson \
        -filesearchcommand -filterlabel -filteron \
        -filetype -invalid -mask -nomatchstring \
        -selectionlabel -selectionon -sashcursor
    }
    grid $itk_component(fsb) -sticky nsew
    grid rowconfigure $itk_interior 0 -weight 1
    grid columnconfigure $itk_interior 0 -weight 1
    
    $itk_component(fsb) component filter configure \
    -focuscommand [itcl::code $this default Apply]
    $itk_component(fsb) component selection configure \
    -focuscommand [itcl::code $this default OK]
    $itk_component(fsb) component dirs configure \
        -dblclickcommand [itcl::code $this _dbldir]
    $itk_component(fsb) component files configure \
        -dblclickcommand [itcl::code $this invoke] 

    buttonconfigure Apply -text "Filter" \
        -command [itcl::code $itk_component(fsb) filter]
    
    set itk_interior [$itk_component(fsb) childsite]
    
    hide Help

    eval itk_initialize $args
}   

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: childsite
#
# Thinwrapped method of file selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectiondialog::childsite {} {
    return [$itk_component(fsb) childsite]
}

# ------------------------------------------------------------------
# METHOD: get
#
# Thinwrapped method of file selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectiondialog::get {} {
    return [$itk_component(fsb) get]
}

# ------------------------------------------------------------------
# METHOD: filter
#
# Thinwrapped method of file selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectiondialog::filter {} {
    return [$itk_component(fsb) filter]
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _dbldir
#
# Double select in directory list.  If the files list is on then
# make the default button the filter and invoke.  If not, just invoke.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectiondialog::_dbldir {} {
    if {$itk_option(-fileson)} {
    default Apply
    }

    invoke
}

Added library/feedback.itk.









































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
#
# Feedback
# ----------------------------------------------------------------------
# Implements a Feedback widget, to display feedback on the status of an 
# process to the user. Display is given as a percentage and as a 
# thermometer type bar. Options exist for adding a label and controlling its
# position.
#
# ----------------------------------------------------------------------
#  AUTHOR: Kris Raney                    EMAIL: kraney@spd.dsccc.com
#
#  @(#) $Id: feedback.itk,v 1.5 2001/08/15 18:32:18 smithc Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1996 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software
# and its documentation for any purpose, and without fee or written
# agreement with DSC, is hereby granted, provided that the above copyright
# notice appears in all copies and that both the copyright notice and
# warranty disclaimer below appear in supporting documentation, and that
# the names of DSC Technologies Corporation or DSC Communications
# Corporation not be used in advertising or publicity pertaining to the
# software without specific, written prior permission.
#
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
# SOFTWARE.
# ======================================================================

# Acknowledgements:
#
# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his 
# feedback.tcl code from tk inspect. The original code is copyright 1995
# Lawrence Berkeley Laboratory.
#
# This software is copyright (C) 1994 by the Lawrence Berkeley Laboratory.
#  
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that: (1) source code distributions
# retain the above copyright notice and this paragraph in its entirety, (2)
# distributions including binary code include the above copyright notice and
# this paragraph in its entirety in the documentation or other materials
# provided with the distribution, and (3) all advertising materials mentioning
# features or use of this software display the following acknowledgement:
# ``This product includes software developed by the University of California,
# Lawrence Berkeley Laboratory and its contributors.'' Neither the name of
# the University nor the names of its contributors may be used to endorse
# or promote products derived from this software without specific prior
# written permission.
#  
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.

#
# Default resources.
#
option add *Feedback.borderWidth	2		widgetDefault
option add *Feedback.labelPos		n		widgetDefault
option add *Feedback.barHeight		20		widgetDefault
option add *Feedback.troughColor	White		widgetDefault
option add *Feedback.barColor		Blue	        widgetDefault

#
# Usual options.
#
itk::usual Feedback {
    keep -background -cursor -foreground
}

# ------------------------------------------------------------------
#                          FEEDBACK
# ------------------------------------------------------------------
itcl::class iwidgets::Feedback {
    inherit iwidgets::Labeledwidget

    constructor {args} {}
    destructor {}

    itk_option define -steps steps Steps 10

    public {
	method reset {}
	method step {{inc 1}}
    }

    private {
	method _display

	variable _barwidth 0
	variable _stepval 0
    }
}

#
# Provide a lowercased access method for the Dialogshell class.
# 
proc ::iwidgets::feedback {pathName args} {
    uplevel ::iwidgets::Feedback $pathName $args
}

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Feedback::constructor {args} {
    itk_component add trough {
	frame $itk_interior.trough -relief sunken
    } {
	usual
	keep -borderwidth
	rename -background -troughcolor troughColor TroughColor
	rename -height -barheight barHeight Height
    }

    itk_component add bar {
	frame $itk_component(trough).bar -relief raised
    } {
	usual
	keep -borderwidth
	rename -background -barcolor barColor BarColor
	rename -height -barheight barHeight Height
    }
    pack $itk_component(bar) -side left -fill y -anchor w

    itk_component add percentage {
	label $itk_interior.percentage -text "0%"
    }
    grid $itk_component(trough) -row 1 -column 0 -sticky sew -padx 2 -pady 2
    grid $itk_component(percentage) -row 2 -column 0 -sticky nsew -padx 2 -pady 2
    grid rowconfigure $itk_interior 0 -weight 1
    grid rowconfigure $itk_interior 1 -weight 1
    grid columnconfigure $itk_interior 0 -weight 1

    bind $itk_component(hull) <Configure> [itcl::code $this _display]

    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                          DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Feedback::destructor {} {
}

# ------------------------------------------------------------------
#                            OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -steps
#
# Set the total number of steps.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Feedback::steps {
    step 0
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# -----------------------------------------------------------------------------
# PROTECTED METHOD: _display 
#
# Displays the bar in the trough with the width set using the current number
# of steps.
# -----------------------------------------------------------------------------
itcl::body iwidgets::Feedback::_display {} {
    update idletasks
    set troughwidth [winfo width $itk_component(trough)]
    set _barwidth [expr {
      (1.0*$troughwidth-(2.0*[$itk_component(trough) cget -borderwidth])) /
      $itk_option(-steps)}]
    set fraction [expr {int((1.0*$_stepval)/$itk_option(-steps)*100.0)}]

    $itk_component(percentage) config -text "$fraction%"
    $itk_component(bar) config -width [expr {$_barwidth*$_stepval}]

    update
}

# ------------------------------------------------------------------
# METHOD: reset
#
# Resets the status bar to 0
# ------------------------------------------------------------------
itcl::body iwidgets::Feedback::reset {} {
    set _stepval 0
    _display 
}

# ------------------------------------------------------------------
# METHOD: step ?inc?
#
# Increase the value of the status bar by inc. Default to 1
# ------------------------------------------------------------------
itcl::body iwidgets::Feedback::step {{inc 1}} {

    if {$_stepval >= $itk_option(-steps)} {
	return
    }

    incr _stepval $inc
    _display 
}

Added library/fileselectionbox.itk.

































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
#
# Fileselectionbox
# ----------------------------------------------------------------------
# Implements a file selection box in a style similar to the OSF/Motif 
# standard XmFileselectionbox composite widget.  The Fileselectionbox 
# is composed of directory and file scrolled lists as well as filter 
# and selection entry fields.
#
# ----------------------------------------------------------------------
#  AUTHOR: Mark L. Ulferts               EMAIL: mulferts@spd.dsccc.com
#
#  @(#) $Id: fileselectionbox.itk,v 1.3 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1997 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software
# and its documentation for any purpose, and without fee or written
# agreement with DSC, is hereby granted, provided that the above copyright
# notice appears in all copies and that both the copyright notice and
# warranty disclaimer below appear in supporting documentation, and that
# the names of DSC Technologies Corporation or DSC Communications
# Corporation not be used in advertising or publicity pertaining to the
# software without specific, written prior permission.
#
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Fileselectionbox {
    keep -activebackground -activerelief -background -borderwidth -cursor \
         -elementborderwidth -foreground -highlightcolor -highlightthickness \
         -insertbackground -insertborderwidth -insertofftime -insertontime \
         -insertwidth -jump -labelfont -selectbackground -selectborderwidth \
         -textbackground -textfont -troughcolor
}

# ------------------------------------------------------------------
#                          FILESELECTIONBOX
# ------------------------------------------------------------------
itcl::class iwidgets::Fileselectionbox {
    inherit itk::Widget

    constructor {args} {}
    destructor {}

    itk_option define -childsitepos childSitePos Position s
    itk_option define -fileson filesOn FilesOn true
    itk_option define -dirson dirsOn DirsOn true
    itk_option define -selectionon selectionOn SelectionOn true
    itk_option define -filteron filterOn FilterOn true
    itk_option define -mask mask Mask {*}
    itk_option define -directory directory Directory {}
    itk_option define -automount automount Automount {}
    itk_option define -nomatchstring noMatchString NoMatchString {}
    itk_option define -dirsearchcommand dirSearchCommand Command {}
    itk_option define -filesearchcommand fileSearchCommand Command {}
    itk_option define -selectioncommand selectionCommand Command {}
    itk_option define -filtercommand filterCommand Command {}
    itk_option define -selectdircommand selectDirCommand Command {}
    itk_option define -selectfilecommand selectFileCommand Command {}
    itk_option define -invalid invalid Command {bell}
    itk_option define -filetype fileType FileType {regular}
    itk_option define -width width Width 350
    itk_option define -height height Height 300

    public {
	method childsite {}
	method get {}
	method filter {}
    }

    public {
	method _selectDir {}
	method _dblSelectDir {}
	method _selectFile {}
	method _selectSelection {}
	method _selectFilter {}
    }

    protected {
	method _packComponents {{when later}}
	method _updateLists {{when later}}
    }

    private {
	method _setFilter {}
	method _setSelection {}
	method _setDirList {}
	method _setFileList {}

	method _nPos {}
	method _sPos {}
	method _ePos {}
	method _wPos {}
	method _topPos {}
	method _centerPos {}
	method _bottomPos {}

	variable _packToken ""      ;# non-null => _packComponents pending
	variable _updateToken ""    ;# non-null => _updateLists pending
	variable _pwd "."           ;# present working dir
	variable _interior          ;# original interior setting
    }
}

#
# Provide a lowercased access method for the Fileselectionbox class.
#
proc ::iwidgets::fileselectionbox {pathName args} {
    uplevel ::iwidgets::Fileselectionbox $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *Fileselectionbox.borderWidth 2 widgetDefault

option add *Fileselectionbox.filterLabel Filter widgetDefault
option add *Fileselectionbox.dirsLabel Directories widgetDefault
option add *Fileselectionbox.filesLabel Files widgetDefault
option add *Fileselectionbox.selectionLabel Selection widgetDefault

option add *Fileselectionbox.width 350 widgetDefault
option add *Fileselectionbox.height 300 widgetDefault

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::constructor {args} {
    #
    # Add back to the hull width and height options and make the
    # borderwidth zero since we don't need it.
    #
    itk_option add hull.width hull.height
    component hull configure -borderwidth 0

    set _interior $itk_interior

    #
    # Create the filter entry.
    #
    itk_component add filter {
        iwidgets::Entryfield $itk_interior.filter -labelpos nw \
	    -command [itcl::code $this _selectFilter] -exportselection 0
    } {
	usual

        rename -labeltext -filterlabel filterLabel Text
    }

    #
    # Create the directory list.
    #
    itk_component add dirs {
        iwidgets::Scrolledlistbox $itk_interior.dirs \
	    -selectioncommand [itcl::code $this _selectDir] \
	    -selectmode single -exportselection 0 \
	    -visibleitems 1x1 -labelpos nw \
	    -hscrollmode static -vscrollmode static \
	    -dblclickcommand [itcl::code $this _dblSelectDir]
    } {
	usual

        rename -labeltext -dirslabel dirsLabel Text
    }

    #
    # Create the files list.
    #
    itk_component add files {
        iwidgets::Scrolledlistbox $itk_interior.files \
	    -selectioncommand [itcl::code $this _selectFile] \
	    -selectmode single -exportselection 0 \
	    -visibleitems 1x1 -labelpos nw \
	    -hscrollmode static -vscrollmode static
    } {
	usual

        rename -labeltext -fileslabel filesLabel Text
    }

    #
    # Create the selection entry.
    #
    itk_component add selection {
      iwidgets::Entryfield $itk_interior.selection -labelpos nw \
	  -command [itcl::code $this _selectSelection] -exportselection 0
    } {
	usual

        rename -labeltext -selectionlabel selectionLabel Text
    }

    #
    # Create the child site widget.
    #
    itk_component add -protected childsite {
        frame $itk_interior.fsbchildsite
    } 

    #
    # Set the interior variable to the childsite for derived classes.
    #
    set itk_interior $itk_component(childsite)

    #
    # Explicitly handle configs that may have been ignored earlier.
    #
    eval itk_initialize $args

    #
    # When idle, pack the childsite and update the lists.
    #
    _packComponents
    _updateLists
}

# ------------------------------------------------------------------
#                           DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::destructor {} {
    if {$_packToken != ""} {after cancel $_packToken}
    if {$_updateToken != ""} {after cancel $_updateToken}
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -childsitepos
#
# Specifies the position of the child site in the selection box.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::childsitepos {
    _packComponents
}

# ------------------------------------------------------------------
# OPTION: -fileson
#
# Specifies whether or not to display the files list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::fileson {
    _packComponents
}

# ------------------------------------------------------------------
# OPTION: -dirson
#
# Specifies whether or not to display the dirs list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::dirson {
    _packComponents
}

# ------------------------------------------------------------------
# OPTION: -selectionon
#
# Specifies whether or not to display the selection entry widget.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::selectionon {
    _packComponents
}

# ------------------------------------------------------------------
# OPTION: -filteron
#
# Specifies whether or not to display the filter entry widget.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::filteron {
    _packComponents
}

# ------------------------------------------------------------------
# OPTION: -mask
#
# Specifies the initial file mask string.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::mask {
    global tcl_platform
    set prefix $_pwd

    #
    # Remove automounter paths.
    #
    if {$tcl_platform(platform) == "unix"} {
        if {$itk_option(-automount) != {}} {
            foreach autoDir $itk_option(-automount) {
                # Use catch because we can't be sure exactly what strings
                # were passed into the -automount option
                catch {
                    if {[regsub ^/$autoDir $prefix {} prefix] != 0} {
                        break
                    }
                }
            }
        }
    }

    set curFilter $itk_option(-mask);
    $itk_component(filter) delete 0 end
    $itk_component(filter) insert 0 [file join $_pwd $itk_option(-mask)]

    #
    # Make sure the right most text is visable.
    #
    $itk_component(filter) xview moveto 1
}

# ------------------------------------------------------------------
# OPTION: -directory
#
# Specifies the initial default directory.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::directory {
    if {$itk_option(-directory) != {}} {
        if {! [file exists $itk_option(-directory)]} {
            error "bad directory option \"$itk_option(-directory)\":\
                    directory does not exist"
        }

        set olddir [pwd]
        cd $itk_option(-directory)
        set _pwd [pwd]
        cd $olddir

        configure -mask $itk_option(-mask)
        _selectFilter
    }
}

# ------------------------------------------------------------------
# OPTION: -automount
#
# Specifies list of directory prefixes to ignore. Typically, this
# option would be used with values such as:
#   -automount {export tmp_mnt}
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::automount {
}

# ------------------------------------------------------------------
# OPTION: -nomatchstring
#
# Specifies the string to be displayed in the files list should
# not regular files exist in the directory.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::nomatchstring {
}

# ------------------------------------------------------------------
# OPTION: -dirsearchcommand
#
# Specifies a command to be executed to perform a directory search.
# The command will receive the current working directory and filter
# mask as arguments.  The command should return a list of files which
# will be placed into the directory list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::dirsearchcommand {
}

# ------------------------------------------------------------------
# OPTION: -filesearchcommand
#
# Specifies a command to be executed to perform a file search.
# The command will receive the current working directory and filter
# mask as arguments.  The command should return a list of files which
# will be placed into the file list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::filesearchcommand {
}

# ------------------------------------------------------------------
# OPTION: -selectioncommand
#
# Specifies a command to be executed upon pressing return in the
# selection entry widget.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::selectioncommand {
}

# ------------------------------------------------------------------
# OPTION: -filtercommand
#
# Specifies a command to be executed upon pressing return in the
# filter entry widget.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::filtercommand {
}

# ------------------------------------------------------------------
# OPTION: -selectdircommand
#
# Specifies a command to be executed following selection of a
# directory in the directory list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::selectdircommand {
}

# ------------------------------------------------------------------
# OPTION: -selectfilecommand
#
# Specifies a command to be executed following selection of a
# file in the files list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::selectfilecommand {
}

# ------------------------------------------------------------------
# OPTION: -invalid
#
# Specify a command to executed should the filter contents be
# proven invalid.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::invalid {
}

# ------------------------------------------------------------------
# OPTION: -filetype
#
# Specify the type of files which may appear in the file list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::filetype {
    switch $itk_option(-filetype) {
        regular -
        directory -
        any {
        }
        default {
            error "bad filetype option \"$itk_option(-filetype)\":\
                    should be regular, directory, or any"
        }
    }

    _updateLists
}

# ------------------------------------------------------------------
# OPTION: -width
#
# Specifies the width of the file selection box.  The value may be
# specified in any of the forms acceptable to Tk_GetPixels.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::width {
    #
    # The width option was added to the hull in the constructor.
    # So, any width value given is passed automatically to the
    # hull.  All we have to do is play with the propagation.
    #
    if {$itk_option(-width) != 0} {
	set propagate 0
    } else {
	set propagate 1
    }

    #
    # Due to a bug in the tk4.2 grid, we have to check the 
    # propagation before setting it.  Setting it to the same
    # value it already is will cause it to toggle.
    #
    if {[grid propagate $itk_component(hull)] != $propagate} {
	grid propagate $itk_component(hull) $propagate
    }
}

# ------------------------------------------------------------------
# OPTION: -height
#
# Specifies the height of the file selection box.  The value may be
# specified in any of the forms acceptable to Tk_GetPixels.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Fileselectionbox::height {
    #
    # The height option was added to the hull in the constructor.
    # So, any height value given is passed automatically to the
    # hull.  All we have to do is play with the propagation.
    #
    if {$itk_option(-height) != 0} {
	set propagate 0
    } else {
	set propagate 1
    }

    #
    # Due to a bug in the tk4.2 grid, we have to check the 
    # propagation before setting it.  Setting it to the same
    # value it already is will cause it to toggle.
    #
    if {[grid propagate $itk_component(hull)] != $propagate} {
	grid propagate $itk_component(hull) $propagate
    }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: childsite
#
# Returns the path name of the child site widget.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::childsite {} {
    return $itk_component(childsite)
}

# ------------------------------------------------------------------
# METHOD: get
#
# Returns the current selection.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::get {} {
    return [$itk_component(selection) get]
}

# ------------------------------------------------------------------
# METHOD: filter
#
# The user has pressed Return in the filter.  Make sure the contents
# contain a valid directory before setting default to directory.
# Use the invalid option to warn the user of any problems.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::filter {} {
    set newdir [file dirname [$itk_component(filter) get]]

    if {! [file exists $newdir]} {
	uplevel #0 "$itk_option(-invalid)"
	return
    }

    set _pwd $newdir;
    if {$_pwd == "."} {set _pwd [pwd]};

    _updateLists
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _updateLists ?now?
#
# Updates the contents of both the file and directory lists, as well
# resets the positions of the filter, and lists.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_updateLists {{when "later"}} {
    switch -- $when {
        later {
            if {$_updateToken == ""} {
                set _updateToken [after idle [itcl::code $this _updateLists now]]
            }
        }
        now {
            if {$itk_option(-dirson)} {_setDirList}
            if {$itk_option(-fileson)} {_setFileList}

            if {$itk_option(-filteron)} {
              _setFilter
            }
            if {$itk_option(-selectionon)} {
                $itk_component(selection) icursor end
            }
            if {$itk_option(-dirson)} {
                $itk_component(dirs) justify left
            }
            if {$itk_option(-fileson)} {
                $itk_component(files) justify left
            }
            set _updateToken ""
        }
        default {
            error "bad option \"$when\": should be later or now"
        }
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _setFilter
#
# Set the filter to the current selection in the directory list plus
# any existing mask in the filter.  Translate the two special cases
# of '.', and '..' directory names to full path names..
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_setFilter {} {
    global tcl_platform
    set prefix [$itk_component(dirs) getcurselection]
    set curFilter [file tail [$itk_component(filter) get]]

    while {[regexp {\.$} $prefix]} {
	if {[file tail $prefix] == "."} {
	    if {$prefix == "."} {
		if {$_pwd == "."} {
		    set _pwd [pwd]
		} elseif {$_pwd == ".."} {
		    set _pwd [file dirname [pwd]]
		}
		set prefix $_pwd
	    } else {
		set prefix [file dirname $prefix]
	    }
	} elseif {[file tail $prefix] == ".."} {
	    if {$prefix != ".."} {
		set prefix [file dirname [file dirname $prefix]]
	    } else {
		if {$_pwd == "."} {
		    set _pwd [pwd]
		} elseif {$_pwd == ".."} {
		    set _pwd [file dirname [pwd]]
		}
		set prefix [file dirname $_pwd]
	    }
	} else {
	    break
	}
    }

    if { [file pathtype $prefix] != "absolute" } {
        set prefix [file join $_pwd $prefix]
    }

    #
    # Remove automounter paths.
    #
    if {$tcl_platform(platform) == "unix"} {
        if {$itk_option(-automount) != {}} {
            foreach autoDir $itk_option(-automount) {
                # Use catch because we can't be sure exactly what strings
                # were passed into the -automount option
                catch {
                    if {[regsub ^/$autoDir $prefix {} prefix] != 0} {
                        break
                    }
                }
            }
        }
    }

    $itk_component(filter) delete 0 end
    $itk_component(filter) insert 0 [file join $prefix $curFilter]

    #
    # Make sure insertion cursor is at the end.
    #
    $itk_component(filter) icursor end

    #
    # Make sure the right most text is visable.
    #
    $itk_component(filter) xview moveto 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _setSelection
#
# Set the contents of the selection entry to either the current
# selection of the file or directory list dependent on which lists
# are currently mapped.  For the file list, avoid seleciton of the
# no match string.  As for the directory list, translate file names.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_setSelection {} {
    global tcl_platform
    $itk_component(selection) delete 0 end

    if {$itk_option(-fileson)} {
        set selection [$itk_component(files) getcurselection]

        if {$selection != $itk_option(-nomatchstring)} {
	    if {[file pathtype $selection] != "absolute"} {
		set selection [file join $_pwd $selection]
	    }

	    #
	    # Remove automounter paths.
	    #
        if {$tcl_platform(platform) == "unix"} {
            if {$itk_option(-automount) != {}} {
                foreach autoDir $itk_option(-automount) {
                    # Use catch because we can't be sure exactly what strings
                    # were passed into the -automount option
                    catch {
                        if {[regsub ^/$autoDir $selection {} selection] != 0} {
                            break
                        }
                    }
                }
            }
        }

	    $itk_component(selection) insert 0 $selection
        } else {
	    $itk_component(files) selection clear 0 end
	}

    } else {
        set selection [$itk_component(dirs) getcurselection]

	if {[file tail $selection] == "."} {
	    if {$selection != "."} {
		set selection [file dirname $selection]
	    } else {
		set selection $_pwd
	    }
	} elseif {[file tail $selection] == ".."} {
	    if {$selection != ".."} {
		set selection [file dirname [file dirname $selection]]
	    } else {
		set selection [file join $_pwd ..]
	    }
	} else {
	    set selection [file join $_pwd $selection]
	}

	#
    # Remove automounter paths.
	#
    if {$tcl_platform(platform) == "unix"} {
        if {$itk_option(-automount) != {}} {
            foreach autoDir $itk_option(-automount) {
                # Use catch because we can't be sure exactly what strings
                # were passed into the -automount option
                catch {
                    if {[regsub ^/$autoDir $selection {} selection] != 0} {
                        break
                    }
                }
            }
        }
    }

	$itk_component(selection) delete 0 end
        $itk_component(selection) insert 0 $selection
    }

    $itk_component(selection) icursor end

    #
    # Make sure the right most text is visable.
    #
    $itk_component(selection) xview moveto 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _setDirList
#
# Clear the directory list and dependent on whether the user has
# defined their own search procedure or not fill the list with their
# results or those of a glob.  Select the first element if it exists.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_setDirList {} {
    $itk_component(dirs) clear

    if {$itk_option(-dirsearchcommand) == {}} {
        foreach i [lsort [glob -nocomplain \
			      [file join $_pwd .*] [file join $_pwd *]]] {
            if {[file isdirectory $i]} {
		$itk_component(dirs) insert end [file tail "$i"]
            }
        }

    } else {
        set mask [file tail [$itk_component(filter) get]]

        foreach file [uplevel #0 $itk_option(-dirsearchcommand) $_pwd $mask] {
            $itk_component(dirs) insert end $file
        }
    }

    if {[$itk_component(dirs) size]} {
        $itk_component(dirs) selection clear 0 end
        $itk_component(dirs) selection set 0
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _setFileList
#
# Clear the file list and dependent on whether the user has defined
# their own search procedure or not fill the list with their results
# or those of a 'glob'.  If the files list has no contents, then set
# the files list to the 'nomatchstring'.  Clear all selections.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_setFileList {} {
    $itk_component(files) clear
    set mask [file tail [$itk_component(filter) get]]

    if {$itk_option(-filesearchcommand) == {}} {
	if {$mask == "*"} {
	    set files [lsort [glob -nocomplain \
				  [file join $_pwd .*] [file join $_pwd *]]]
	} else {
	    set files [lsort [glob -nocomplain [file join $_pwd $mask]]]
	}

        foreach i $files {
            if {($itk_option(-filetype) == "regular" && \
		    ! [file isdirectory $i]) || \
		    ($itk_option(-filetype) == "directory" && \
		    [file isdirectory $i]) || \
		    ($itk_option(-filetype) == "any")} {
		$itk_component(files) insert end [file tail "$i"]
            }
        }

    } else {
        foreach file [uplevel #0 $itk_option(-filesearchcommand) $_pwd $mask] {
            $itk_component(files) insert end $file
        }
    }

    if {[$itk_component(files) size] == 0} {
	if {$itk_option(-nomatchstring) != {}} {
	    $itk_component(files) insert end $itk_option(-nomatchstring)
	}
    }

    $itk_component(files) selection clear 0 end
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _selectDir
#
# For a selection in the directory list, set the filter and possibly
# the selection entry based on the fileson option.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_selectDir {} {
    _setFilter

    if {$itk_option(-fileson)} {} {
        _setSelection
    }

    if {$itk_option(-selectdircommand) != {}} {
        uplevel #0 $itk_option(-selectdircommand)
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _dblSelectDir
#
# For a double click event in the directory list, select the
# directory, set the default to the selection, and update both the
# file and directory lists.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_dblSelectDir {} {
    filter
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _selectFile
#
# The user has selected a file.  Put the current selection in the
# file list in the selection entry widget.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_selectFile {} {
    _setSelection

    if {$itk_option(-selectfilecommand) != {}} {
        uplevel #0 $itk_option(-selectfilecommand)
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _selectSelection
#
# The user has pressed Return in the selection entry widget.  Call
# the defined selection command if it exists.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_selectSelection {} {
    if {$itk_option(-selectioncommand) != {}} {
        uplevel #0 $itk_option(-selectioncommand)
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _selectFilter
#
# The user has pressed Return in the filter entry widget.  Call the
# defined selection command if it exists, otherwise just filter.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_selectFilter {} {
    if {$itk_option(-filtercommand) != {}} {
        uplevel #0 $itk_option(-filtercommand)
    } else {
        filter
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _packComponents
#
# Pack the selection, items, and child site widgets based on options.
# Using the -in option of pack, put the childsite around the frame
# in the hull for n, s, e, and w positions.  Make sure and raise 
# the child site since using the 'in' option may obscure the site.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_packComponents {{when "later"}} {
    if {$when == "later"} {
        if {$_packToken == ""} {
            set _packToken [after idle [itcl::code $this _packComponents now]]
        }
        return
    } elseif {$when != "now"} {
        error "bad option \"$when\": should be now or later"
    }

    set _packToken ""

    #
    # Forget about any previous placements via the grid and
    # reset all the possible minsizes and weights for all
    # the rows and columns.
    #
    foreach component {childsite filter dirs files selection} {
	grid forget $itk_component($component)
    }

    for {set row 0} {$row < 6} {incr row} {
	grid rowconfigure $_interior $row -minsize 0 -weight 0
    }

    for {set col 0} {$col < 4} {incr col} {
	grid columnconfigure $_interior $col -minsize 0 -weight 0
    }

    #
    # Place all the components based on the childsite poisition
    # option.
    #
    switch $itk_option(-childsitepos) {
        n { _nPos }

        w { _wPos }

        s { _sPos }

        e { _ePos }

	center { _centerPos }

	top { _topPos }

	bottom { _bottomPos }

        default {
            error "bad childsitepos option \"$itk_option(-childsitepos)\":\
                    should be n, e, s, w, center, top, or bottom"
        }
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _nPos
#
# Position the childsite to the north and all the other components
# appropriately based on the individual "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_nPos {} {
    grid $itk_component(childsite) -row 0 -column 0 \
	-columnspan 3 -rowspan 1 -sticky nsew

    if {$itk_option(-filteron)} {
	grid $itk_component(filter) -row 1 -column 0 \
	    -columnspan 3 -sticky ew
	grid rowconfigure $_interior 2 -minsize 7
    }

    if {$itk_option(-dirson)} {
	grid $itk_component(dirs) -row 3 -column 0 \
	    -columnspan 1 -sticky nsew
    } 
    if {$itk_option(-fileson)} {
	grid $itk_component(files) -row 3 -column 2 \
	    -columnspan 1 -sticky nsew
    } 
    if {$itk_option(-dirson)} {
	if {$itk_option(-fileson)} {
	    grid columnconfigure $_interior 1 -minsize 7
	} else {
	    grid configure $itk_component(dirs) -columnspan 3 -column 0
	}
    } else {
	if {$itk_option(-fileson)} {
	    grid configure $itk_component(files) -columnspan 3 -column 0
	}
    }

    grid rowconfigure $_interior 3 -weight 1

    if {$itk_option(-selectionon)} {
	grid rowconfigure $_interior 4 -minsize 7
	grid $itk_component(selection) -row 5 -column 0 \
	    -columnspan 3 -sticky ew
    }

    grid columnconfigure $_interior 0 -weight 1
    grid columnconfigure $_interior 2 -weight 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _sPos
#
# Position the childsite to the south and all the other components
# appropriately based on the individual "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_sPos {} {
    if {$itk_option(-filteron)} {
	grid $itk_component(filter) -row 0 -column 0 \
	    -columnspan 3 -sticky ew
	grid rowconfigure $_interior 1 -minsize 7
    }

    if {$itk_option(-dirson)} {
	grid $itk_component(dirs) -row 2 -column 0 \
	    -columnspan 1 -sticky nsew
    }
    if {$itk_option(-fileson)} {
	grid $itk_component(files) -row 2 -column 2 \
	    -columnspan 1 -sticky nsew
    }
    if {$itk_option(-dirson)} {
	if {$itk_option(-fileson)} {
	    grid columnconfigure $_interior 1 -minsize 7
	} else {
	    grid configure $itk_component(dirs) -columnspan 3 -column 0
	}
    } else {
	if {$itk_option(-fileson)} {
	    grid configure $itk_component(files) -columnspan 3 -column 0
	}
    }
    
    grid rowconfigure $_interior 2 -weight 1

    if {$itk_option(-selectionon)} {
	grid rowconfigure $_interior 3 -minsize 7
	grid $itk_component(selection) -row 4 -column 0 \
	    -columnspan 3 -sticky ew
    }
    
    grid $itk_component(childsite) -row 5 -column 0 \
	-columnspan 3 -rowspan 1 -sticky nsew
    grid columnconfigure $_interior 0 -weight 1
    grid columnconfigure $_interior 2 -weight 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _ePos
#
# Position the childsite to the east and all the other components
# appropriately based on the individual "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_ePos {} {
    if {$itk_option(-filteron)} {
	grid $itk_component(filter) -row 0 -column 0 \
	    -columnspan 3 -sticky ew
	grid rowconfigure $_interior 1 -minsize 7
    }

    if {$itk_option(-dirson)} {
	grid $itk_component(dirs) -row 2 -column 0 \
	    -columnspan 1 -sticky nsew
    }
    if {$itk_option(-fileson)} {
	grid $itk_component(files) -row 2 -column 2 \
	    -columnspan 1 -sticky nsew
    }
    if {$itk_option(-dirson)} {
	if {$itk_option(-fileson)} {
	    grid columnconfigure $_interior 1 -minsize 7
	} else {
	    grid configure $itk_component(dirs) -columnspan 3 -column 0
	}
    } else {
	if {$itk_option(-fileson)} {
	    grid configure $itk_component(files) -columnspan 3 -column 0
	}
    }

    grid rowconfigure $_interior 2 -weight 1

    if {$itk_option(-selectionon)} {
	grid rowconfigure $_interior 3 -minsize 7
	grid $itk_component(selection) -row 4 -column 0 \
	    -columnspan 3 -sticky ew
    }

    grid $itk_component(childsite) -row 0 -column 3 \
	-rowspan 5 -columnspan 1 -sticky nsew
    grid columnconfigure $_interior 0 -weight 1
    grid columnconfigure $_interior 2 -weight 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _wPos
#
# Position the childsite to the west and all the other components
# appropriately based on the individual "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_wPos {} {
    grid $itk_component(childsite) -row 0 -column 0 \
	-rowspan 5 -columnspan 1 -sticky nsew

    if {$itk_option(-filteron)} {
	grid $itk_component(filter) -row 0 -column 1 \
	    -columnspan 3 -sticky ew
	grid rowconfigure $_interior 1 -minsize 7
    } 

    if {$itk_option(-dirson)} {
	grid $itk_component(dirs) -row 2 -column 1 \
	    -columnspan 1 -sticky nsew
    }
    if {$itk_option(-fileson)} {
	grid $itk_component(files) -row 2 -column 3 \
	    -columnspan 1 -sticky nsew
    }
    if {$itk_option(-dirson)} {
	if {$itk_option(-fileson)} {
	    grid columnconfigure $_interior 2 -minsize 7
	} else {
	    grid configure $itk_component(dirs) -columnspan 3 -column 1
	}
    } else {
	if {$itk_option(-fileson)} {
	    grid configure $itk_component(files) -columnspan 3 -column 1
	}
    }

    grid rowconfigure $_interior 2 -weight 1

    if {$itk_option(-selectionon)} {
	grid rowconfigure $_interior 3 -minsize 7
	grid $itk_component(selection) -row 4 -column 1 \
	    -columnspan 3 -sticky ew
    }

    grid columnconfigure $_interior 1 -weight 1
    grid columnconfigure $_interior 3 -weight 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _topPos
#
# Position the childsite below the filter but above the lists and 
# all the other components appropriately based on the individual 
# "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_topPos {} {
    if {$itk_option(-filteron)} {
	grid $itk_component(filter) -row 0 -column 0 \
	    -columnspan 3 -sticky ew
    }

    grid $itk_component(childsite) -row 1 -column 0 \
	-columnspan 3 -rowspan 1 -sticky nsew

    if {$itk_option(-dirson)} {
	grid $itk_component(dirs) -row 2 -column 0 -sticky nsew
    }
    if {$itk_option(-fileson)} {
	grid $itk_component(files) -row 2 -column 2 -sticky nsew
    }
    if {$itk_option(-dirson)} {
	if {$itk_option(-fileson)} {
	    grid columnconfigure $_interior 1 -minsize 7
	} else {
	    grid configure $itk_component(dirs) -columnspan 3 -column 0
	}
    } else {
	if {$itk_option(-fileson)} {
	    grid configure $itk_component(files) -columnspan 3 -column 0
	}
    }

    grid rowconfigure $_interior 2 -weight 1

    if {$itk_option(-selectionon)} {
	grid rowconfigure $_interior 3 -minsize 7
	grid $itk_component(selection) -row 4 -column 0 \
	    -columnspan 3 -sticky ew
    }

    grid columnconfigure $_interior 0 -weight 1
    grid columnconfigure $_interior 2 -weight 1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _centerPos
#
# Position the childsite between the lists and all the other 
# components appropriately based on the individual "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_centerPos {} {
    if {$itk_option(-filteron)} {
	grid $itk_component(filter) -row 0 -column 0 \
	    -columnspan 3 -sticky ew
	grid rowconfigure $_interior 1 -minsize 7
    }

    if {$itk_option(-dirson)} {
	grid $itk_component(dirs) -row 2 -column 0 \
	    -columnspan 1 -sticky nsew
    }
    if {$itk_option(-fileson)} {
	grid $itk_component(files) -row 2 -column 2 \
	    -columnspan 1 -sticky nsew
    }
    grid $itk_component(childsite) -row 2 \
	-columnspan 1 -rowspan 1 -sticky nsew

    if {$itk_option(-dirson)} {
	if {$itk_option(-fileson)} {
	    grid configure $itk_component(childsite) -column 1
	    grid columnconfigure $_interior 0 -weight 1
	    grid columnconfigure $_interior 2 -weight 1

	} else {
	    grid configure $itk_component(dirs) -columnspan 2 -column 0
	    grid configure $itk_component(childsite) -column 2
	    grid columnconfigure $_interior 0 -weight 1
	    grid columnconfigure $_interior 1 -weight 1
	}
    } else {
	grid configure $itk_component(childsite) -column 0
	if {$itk_option(-fileson)} {
	    grid configure $itk_component(files) -columnspan 2 \
		-column 1
	    grid columnconfigure $_interior 1 -weight 1
	    grid columnconfigure $_interior 2 -weight 1
	} else {
	    grid columnconfigure $_interior 0 -weight 1
	}
    }

    grid rowconfigure $_interior 2 -weight 1

    if {$itk_option(-selectionon)} {
	grid rowconfigure $_interior 3 -minsize 7
	grid $itk_component(selection) -row 4 -column 0 \
	    -columnspan 3 -sticky ew
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _bottomPos
#
# Position the childsite below the lists and above the selection
# and all the other components appropriately based on the individual 
# "on" options.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectionbox::_bottomPos {} {
    if {$itk_option(-filteron)} {
	grid $itk_component(filter) -row 0 -column 0 \
	    -columnspan 3 -sticky ew
	grid rowconfigure $_interior 1 -minsize 7
    }

    if {$itk_option(-dirson)} {
	grid $itk_component(dirs) -row 2 -column 0 -sticky nsew
    }
    if {$itk_option(-fileson)} {
	grid $itk_component(files) -row 2 -column 2 -sticky nsew
    }
    if {$itk_option(-dirson)} {
	if {$itk_option(-fileson)} {
	    grid columnconfigure $_interior 1 -minsize 7
	} else {
	    grid configure $itk_component(dirs) -columnspan 3 -column 0
	}
    } else {
	if {$itk_option(-fileson)} {
	    grid configure $itk_component(files) -columnspan 3 -column 0
	}
    }
    grid rowconfigure $_interior 2 -weight 1

    grid $itk_component(childsite) -row 3 -column 0 \
	-columnspan 3 -rowspan 1 -sticky nsew

    if {$itk_option(-selectionon)} {
	grid $itk_component(selection) -row 4 -column 0 \
	    -columnspan 3 -sticky ew
    }

    grid columnconfigure $_interior 0 -weight 1
    grid columnconfigure $_interior 2 -weight 1
}

Added library/fileselectiondialog.itk.











































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#
# Fileselectiondialog
# ----------------------------------------------------------------------
# Implements a file selection box similar to the OSF/Motif standard
# file selection dialog composite widget.  The Fileselectiondialog is 
# derived from the Dialog class and is composed of a FileSelectionBox
# with attributes set to manipulate the dialog buttons.
# 
# ----------------------------------------------------------------------
#  AUTHOR: Mark L. Ulferts               EMAIL: mulferts@spd.dsccc.com
#
#  @(#) $Id: fileselectiondialog.itk,v 1.2 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1995 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Fileselectiondialog {
    keep -activebackground -activerelief -background -borderwidth -cursor \
	 -elementborderwidth -foreground -highlightcolor -highlightthickness \
	 -insertbackground -insertborderwidth -insertofftime -insertontime \
	 -insertwidth -jump -labelfont -modality -selectbackground \
	 -selectborderwidth -textbackground -textfont 
}

# ------------------------------------------------------------------
#                        FILESELECTIONDIALOG
# ------------------------------------------------------------------
itcl::class iwidgets::Fileselectiondialog {
    inherit iwidgets::Dialog

    constructor {args} {}

    public {
	method childsite {}
	method get {}
	method filter {}
    }

    protected method _dbldir {}
}

#
# Provide a lowercased access method for the Fileselectiondialog class.
# 
proc ::iwidgets::fileselectiondialog {pathName args} {
    uplevel ::iwidgets::Fileselectiondialog $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *Fileselectiondialog.borderWidth 2 widgetDefault

option add *Fileselectiondialog.title "File Selection Dialog" widgetDefault

option add *Fileselectiondialog.width 350 widgetDefault
option add *Fileselectiondialog.height 400 widgetDefault

option add *Fileselectiondialog.master "." widgetDefault

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectiondialog::constructor {args} {
    component hull configure -borderwidth 0
    itk_option add hull.width hull.height
    
    #
    # Turn off pack propagation for the hull widget so the width
    # and height options become active.
    #
    pack propagate $itk_component(hull) no
    
    # 
    # Instantiate a file selection box widget.
    #
    itk_component add fsb {
	iwidgets::Fileselectionbox $itk_interior.fsb -width 150 -height 150 \
		-selectioncommand [itcl::code $this invoke] \
	        -selectdircommand [itcl::code $this default Apply] \
	        -selectfilecommand [itcl::code $this default OK]
    } {
	usual

	keep -labelfont -childsitepos -directory -dirslabel \
	    -dirsearchcommand -dirson -fileslabel -fileson \
	    -filesearchcommand -filterlabel -filteron \
	    -filetype -invalid -mask -nomatchstring \
	    -selectionlabel -selectionon
    }
    grid $itk_component(fsb) -sticky nsew
    grid rowconfigure $itk_interior 0 -weight 1
    grid columnconfigure $itk_interior 0 -weight 1
    
    $itk_component(fsb) component filter configure \
	-focuscommand [itcl::code $this default Apply]
    $itk_component(fsb) component selection configure \
	-focuscommand [itcl::code $this default OK]
    $itk_component(fsb) component dirs configure \
		-dblclickcommand [itcl::code $this _dbldir]
    $itk_component(fsb) component files configure \
		-dblclickcommand [itcl::code $this invoke] 

    buttonconfigure Apply -text "Filter" \
	    -command [itcl::code $itk_component(fsb) filter]
    
    set itk_interior [$itk_component(fsb) childsite]
    
    hide Help

    eval itk_initialize $args
}   

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: childsite
#
# Thinwrapped method of file selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectiondialog::childsite {} {
    return [$itk_component(fsb) childsite]
}

# ------------------------------------------------------------------
# METHOD: get
#
# Thinwrapped method of file selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectiondialog::get {} {
    return [$itk_component(fsb) get]
}

# ------------------------------------------------------------------
# METHOD: filter
#
# Thinwrapped method of file selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectiondialog::filter {} {
    return [$itk_component(fsb) filter]
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _dbldir
#
# Double select in directory list.  If the files list is on then
# make the default button the filter and invoke.  If not, just invoke.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectiondialog::_dbldir {} {
    if {$itk_option(-fileson)} {
	default Apply
    }

    invoke
}

Added library/finddialog.itk.

















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
#
# Finddialog
# ----------------------------------------------------------------------
# This class implements a dialog for searching text.  It prompts the
# user for a search string and the method of searching which includes
# case sensitive, regular expressions, backwards, and all.
#
# ----------------------------------------------------------------------
#  AUTHOR: Mark L. Ulferts              EMAIL: mulferts@austin.dsccc.com
#
#  @(#) RCS: $Id: finddialog.itk,v 1.3 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1996 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Finddialog {
    keep -background -cursor -foreground -selectcolor
}

# ------------------------------------------------------------------
#                          IPRFINDDIALOG
# ------------------------------------------------------------------
itcl::class ::iwidgets::Finddialog {
    inherit iwidgets::Dialogshell

    constructor {args} {}

    itk_option define -selectcolor selectColor Background {} 
    itk_option define -clearcommand clearCommand Command {}
    itk_option define -matchcommand matchCommand Command {}
    itk_option define -patternbackground patternBackground Background \#707070
    itk_option define -patternforeground patternForeground Foreground White
    itk_option define -searchbackground searchBackground Background \#c4c4c4
    itk_option define -searchforeground searchForeground Foreground Black
    itk_option define -textwidget textWidget TextWidget {}

    public {
	method clear {}
	method find {}
    }

    protected {
	method _get {setting}
	method _textExists {}

	common _optionValues       ;# Current settings of check buttons.
	common _searchPoint        ;# Starting location for searches
	common _matchLen           ;# Matching pattern string length
    }
}

#
# Provide a lowercased access method for the ::finddialog class.
# 
proc ::iwidgets::finddialog {pathName args} {
    uplevel ::iwidgets::Finddialog $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *Finddialog.title "Find" widgetDefault

# ------------------------------------------------------------------
#                            CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body ::iwidgets::Finddialog::constructor {args} {
    #
    # Add the find pattern entryfield.
    #
    itk_component add pattern {
	iwidgets::Entryfield $itk_interior.pattern -labeltext "Find:"
    } 
    bind [$itk_component(pattern) component entry] \
	    <Return> "[itcl::code $this invoke]; break"
    
    #
    # Add the find all checkbutton.
    #
    itk_component add all {
	checkbutton $itk_interior.all \
	    -variable [itcl::scope _optionValues($this-all)] \
	    -text "All"
    }

    #
    # Add the case consideration checkbutton.
    #
    itk_component add case {
	checkbutton $itk_interior.case \
	    -variable [itcl::scope _optionValues($this-case)] \
	    -text "Consider Case"
    }

    #
    # Add the regular expression checkbutton.
    #
    itk_component add regexp {
	checkbutton $itk_interior.regexp \
	    -variable [itcl::scope _optionValues($this-regexp)] \
	    -text "Use Regular Expression"
    }

    #
    # Add the find backwards checkbutton.
    #
    itk_component add backwards {
	checkbutton $itk_interior.backwards \
	    -variable [itcl::scope _optionValues($this-backwards)] \
	    -text "Find Backwards"
    }

    #
    # Add the find, clear, and close buttons, making find be the default.
    #
    add Find -text Find -command [itcl::code $this find]
    add Clear -text Clear -command [itcl::code $this clear]
    add Close -text Close -command [itcl::code $this deactivate 0]

    default Find

    #
    # Use the grid to layout the components.
    #
    grid $itk_component(pattern) -row 0 -column 0 \
	-padx 10 -pady 10 -columnspan 4 -sticky ew
    grid $itk_component(all) -row 1 -column 0
    grid $itk_component(case) -row 1 -column 1
    grid $itk_component(regexp) -row 1 -column 2
    grid $itk_component(backwards) -row 1 -column 3

    grid columnconfigure $itk_interior 0 -weight 1
    grid columnconfigure $itk_interior 1 -weight 1
    grid columnconfigure $itk_interior 2 -weight 1
    grid columnconfigure $itk_interior 3 -weight 1

    #
    # Initialize all the configuration options.
    #
    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -clearcommand
#
# Specifies a command to be invoked following a clear operation. 
# The command is meant to be a means of notification that the
# clear has taken place and allow other actions to take place such
# as disabling a find again menu.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Finddialog::clearcommand {}

# ------------------------------------------------------------------
# OPTION: -matchcommand
#
# Specifies a command to be invoked following a find operation. 
# The command is called with a match point as an argument.  Should
# a match not be found the match point is {}.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Finddialog::matchcommand {}

# ------------------------------------------------------------------
# OPTION: -patternbackground
#
# Specifies the background color of the text matching the search
# pattern.  It may have any of the forms accepted by Tk_GetColor.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Finddialog::patternbackground {}

# ------------------------------------------------------------------
# OPTION: -patternforeground
#
# Specifies the foreground color of the pattern matching a search
# operation.  It may have any of the forms accepted by Tk_GetColor.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Finddialog::patternforeground {}

# ------------------------------------------------------------------
# OPTION: -searchforeground
#
# Specifies the foreground color of the line containing the matching
# pattern from a search operation.  It may have any of the forms 
# accepted by Tk_GetColor.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Finddialog::searchforeground {}

# ------------------------------------------------------------------
# OPTION: -searchbackground
#
# Specifies the background color of the line containing the matching
# pattern from a search operation.  It may have any of the forms 
# accepted by Tk_GetColor.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Finddialog::searchbackground {}

# ------------------------------------------------------------------
# OPTION: -textwidget
#
# Specifies the scrolledtext or text widget to be searched.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Finddialog::textwidget {
    if {$itk_option(-textwidget) != {}} {
	set _searchPoint($itk_option(-textwidget)) 1.0
    }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# PUBLIC METHOD: clear 
#
# Clear the pattern entryfield and the indicators.  
# ------------------------------------------------------------------
itcl::body ::iwidgets::Finddialog::clear {} {
    $itk_component(pattern) clear

    if {[_textExists]} {
	set _searchPoint($itk_option(-textwidget)) 1.0

	$itk_option(-textwidget) tag remove search-line 1.0 end
	$itk_option(-textwidget) tag remove search-pattern 1.0 end
    }

    if {$itk_option(-clearcommand) != {}} {
	eval $itk_option(-clearcommand)
    }
}

# ------------------------------------------------------------------
# PUBLIC METHOD: find
#
# Search for a specific text string in the text widget given by
# the -textwidget option.  Should this option not be set to an
# existing widget, then a quick exit is made. 
# ------------------------------------------------------------------
itcl::body ::iwidgets::Finddialog::find {} {
    if {! [_textExists]} {
	return
    }

    #
    # Clear any existing indicators in the text widget.
    #
    $itk_option(-textwidget) tag remove search-line 1.0 end
    $itk_option(-textwidget) tag remove search-pattern 1.0 end

    #
    # Make sure the search pattern isn't just blank.  If so, skip this.
    #
    set pattern [_get pattern]

    if {[string trim $pattern] == ""} {
	return
    }

    #
    # After clearing out any old highlight indicators from a previous
    # search, we'll be building our search command piece-meal based on 
    # the current settings of the checkbuttons in the find dialog.  The
    # first we'll add is a variable to catch the count of the length
    # of the string matching the pattern.
    #
    set precmd "$itk_option(-textwidget) search \
	    -count [list [itcl::scope _matchLen($this)]]"

    if {! [_get case]} {
	append precmd " -nocase"
    }

    if {[_get regexp]} {
	append precmd " -regexp"
    } else {
	append precmd " -exact"
    }

    #
    # If we are going to find all matches, then the start point for
    # the search will be the beginning of the text; otherwise, we'll
    # use the last known starting point +/- a character depending on
    # the direction.
    #
    if {[_get all]} {
	set _searchPoint($itk_option(-textwidget)) 1.0
    } else {
	if {[_get backwards]} {
	    append precmd " -backwards"
	} else {
	    append precmd " -forwards"
	}
    }

    #
    # Get the pattern to be matched and add it to the search command.
    # Since it may contain embedded spaces, we'll wrap it in a list.
    #
    append precmd " [list $pattern]"    

    #
    # If the search is for all matches, then we'll be performing the 
    # search until no more matches are found; otherwise, we'll break
    # out of the loop after one search.
    #
    while {1} {
	if {[_get all]} {
	    set postcmd " $_searchPoint($itk_option(-textwidget)) end"

	} else {
	    set postcmd " $_searchPoint($itk_option(-textwidget))"
	}

	#
	# Create the final search command out of the pre and post parts
	# and evaluate it which returns the location of the matching string.
	#
	set cmd {}
	append cmd $precmd $postcmd

	if {[catch {eval $cmd} matchPoint] != 0} {
	    set _searchPoint($itk_option(-textwidget)) 1.0
	    return {}
	}

	#
	# If a match exists, then we'll make this spot be the new starting
	# position.  Then we'll tag the line and the pattern in the line.
	# The foreground and background settings will lite these positions
	# in the text widget up.
	#
	if {$matchPoint != {}} {
	    set _searchPoint($itk_option(-textwidget)) $matchPoint 

	    $itk_option(-textwidget) tag add search-line \
	      "$_searchPoint($itk_option(-textwidget)) linestart" \
		"$_searchPoint($itk_option(-textwidget))" 
	    $itk_option(-textwidget) tag add search-line \
	      "$_searchPoint($itk_option(-textwidget)) + \
               $_matchLen($this) chars" \
	      "$_searchPoint($itk_option(-textwidget)) lineend"
	    $itk_option(-textwidget) tag add search-pattern \
	       $_searchPoint($itk_option(-textwidget)) \
		"$_searchPoint($itk_option(-textwidget)) + \
                 $_matchLen($this) chars"
	}

	#
	# Set the search point for the next time through to be one
	# character more or less from the current search point based
	# on the direction.
	#
	if {[_get all] || ! [_get backwards]} {
	    set _searchPoint($itk_option(-textwidget)) \
		[$itk_option(-textwidget) index \
		     "$_searchPoint($itk_option(-textwidget)) + 1c"]
	} else {
	    set _searchPoint($itk_option(-textwidget)) \
		[$itk_option(-textwidget) index \
		     "$_searchPoint($itk_option(-textwidget)) - 1c"]
	}

	#
	# If this isn't a find all operation or we didn't get a match, exit.
	#
	if {(! [_get all]) || ($matchPoint == {})} {
	    break
	}
    }

    #
    # Configure the colors for the search-line and search-pattern.
    #
    $itk_option(-textwidget) tag configure search-line \
	    -foreground $itk_option(-searchforeground)
    $itk_option(-textwidget) tag configure search-line \
	    -background $itk_option(-searchbackground)
    $itk_option(-textwidget) tag configure search-pattern \
	    -background $itk_option(-patternbackground)
    $itk_option(-textwidget) tag configure search-pattern \
	    -foreground $itk_option(-patternforeground)

    #
    # Adjust the view to be the last matched position.
    #
    if {$matchPoint != {}} {
	$itk_option(-textwidget) see $matchPoint
    }

    #
    # There may be multiple matches of the pattern on a single line,
    # so we'll set the tag priorities such that the pattern tag is higher.
    #
    $itk_option(-textwidget) tag raise search-pattern search-line

    #
    # If a match command is defined, then call it with the match point.
    #
    if {$itk_option(-matchcommand) != {}} {
	[subst $itk_option(-matchcommand)] $matchPoint
    }

    #
    # Return the match point to the caller so they know if we found 
    # anything and if so where
    #
    return $matchPoint
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _get setting
#
# Get the current value for the pattern, case, regexp, or backwards.
# ------------------------------------------------------------------
itcl::body ::iwidgets::Finddialog::_get {setting} {
    switch $setting {
	pattern {
	    return [$itk_component(pattern) get]
	}
	case {
	    return $_optionValues($this-case)
	}
	regexp {
	    return $_optionValues($this-regexp)
	}
	backwards {
	    return $_optionValues($this-backwards)
	}
	all {
	    return $_optionValues($this-all)
	}
	default {
	    error "bad get setting: \"$setting\", should be pattern,\
		    case, regexp, backwards, or all"
	}
    }
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _textExists
#
# Check the validity of the text widget option.  Does it exist and
# is it of the class Text or Scrolledtext.
# ------------------------------------------------------------------
itcl::body ::iwidgets::Finddialog::_textExists {} {
    if {$itk_option(-textwidget) == {}} {
	return 0
    }

    if {! [winfo exists $itk_option(-textwidget)]} {
	error "bad finddialog text widget value: \"$itk_option(-textwidget)\",\
               the widget doesn't exist"
    }

    if {([winfo class $itk_option(-textwidget)] != "Text") &&
	([itcl::find objects -isa iwidgets::Scrolledtext *::$itk_option(-textwidget)] == "")} {
	error "bad finddialog text widget value: \"$itk_option(-textwidget)\",\
               must be of the class Text or based on Scrolledtext"
    }

    return 1
}

Added library/hierarchy.itk.































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
# Hierarchy
# ----------------------------------------------------------------------
# Hierarchical data viewer.  Manages a list of nodes that can be
# expanded or collapsed.  Individual nodes can be highlighted.
# Clicking with the right mouse button on any item brings up a
# special item menu.  Clicking on the background area brings up
# a different popup menu.
# ----------------------------------------------------------------------
#   AUTHOR:  Michael J. McLennan
#            Bell Labs Innovations for Lucent Technologies
#            mmclennan@lucent.com
#
#            Mark L. Ulferts
#            DSC Communications
#            mulferts@austin.dsccc.com
#
#      RCS:  $Id: hierarchy.itk,v 1.9 2002/09/06 16:27:03 smithc Exp $
# ----------------------------------------------------------------------
#                Copyright (c) 1996  Lucent Technologies
# ======================================================================
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that the copyright notice and warranty disclaimer appear in
# supporting documentation, and that the names of Lucent Technologies
# any of their entities not be used in advertising or publicity
# pertaining to distribution of the software without specific, written
# prior permission.
#
# Lucent Technologies disclaims all warranties with regard to this
# software, including all implied warranties of merchantability and
# fitness.  In no event shall Lucent Technologies be liable for any
# special, indirect or consequential damages or any damages whatsoever
# resulting from loss of use, data or profits, whether in an action of
# contract, negligence or other tortuous action, arising out of or in
# connection with the use or performance of this software.
#
# ----------------------------------------------------------------------
#            Copyright (c) 1996 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software 
# and its documentation for any purpose, and without fee or written 
# agreement with DSC, is hereby granted, provided that the above copyright 
# notice appears in all copies and that both the copyright notice and 
# warranty disclaimer below appear in supporting documentation, and that 
# the names of DSC Technologies Corporation or DSC Communications 
# Corporation not be used in advertising or publicity pertaining to the 
# software without specific, written prior permission.
# 
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
# SOFTWARE.
# ======================================================================

#
# Usual options.
#
itk::usual Hierarchy {
    keep -cursor -textfont -font
    keep -background -foreground -textbackground 
    keep -selectbackground -selectforeground 
}

# ------------------------------------------------------------------
#                            HIERARCHY
# ------------------------------------------------------------------
itcl::class iwidgets::Hierarchy {
    inherit iwidgets::Scrolledwidget

    constructor {args} {}

    destructor {}

    itk_option define -alwaysquery alwaysQuery AlwaysQuery 0
    itk_option define -closedicon closedIcon Icon {}
    itk_option define -dblclickcommand dblClickCommand Command {}
    itk_option define -expanded expanded Expanded 0 
    itk_option define -filter filter Filter 0 
    itk_option define -font font Font \
	-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* 
    itk_option define -height height Height 0
    itk_option define -iconcommand iconCommand Command {}
    itk_option define -icondblcommand iconDblCommand Command {}
    itk_option define -imagecommand imageCommand Command {}
    itk_option define -imagedblcommand imageDblCommand Command {}
    itk_option define -imagemenuloadcommand imageMenuLoadCommand Command {}
    itk_option define -markbackground markBackground Foreground #a0a0a0 
    itk_option define -markforeground markForeground Background Black 
    itk_option define -nodeicon nodeIcon Icon {}
    itk_option define -openicon openIcon Icon {}
    itk_option define -querycommand queryCommand Command {}
    itk_option define -selectcommand selectCommand Command {}
    itk_option define -selectbackground selectBackground Foreground #c3c3c3 
    itk_option define -selectforeground selectForeground Background Black 
    itk_option define -textmenuloadcommand textMenuLoadCommand Command {}
    itk_option define -visibleitems visibleItems VisibleItems 80x24
    itk_option define -width width Width 0

    public {
	method clear {}
	method collapse {node}
	method current {}
	method draw {{when -now}}
	method expand {node}
	method expanded {node}
	method expState { }
	method mark {op args}
	method prune {node}
	method refresh {node}
	method selection {op args}
	method toggle {node}
	
	method bbox {index} 
	method compare {index1 op index2} 
	method debug {args} {eval $args}
	method delete {first {last {}}} 
	method dlineinfo {index} 
	method dump {args}
	method get {index1 {index2 {}}} 
	method index {index} 
	method insert {args} 
	method scan {option args} 
	method search {args} 
	method see {index} 
	method tag {op args} 
	method window {option args} 
	method xview {args}
	method yview {args}
    }

    protected {
	method _contents {uid}
	method _post {x y}
	method _drawLevel {node indent}
	method _select {x y}
	method _deselectSubNodes {uid}
	method _deleteNodeInfo {uid}
	method _getParent {uid}
	method _getHeritage {uid}
	method _isInternalTag {tag}
	method _iconSelect {node icon}
	method _iconDblSelect {node icon}
	method _imageSelect {node}
	method _imageDblClick {node}
	method _imagePost {node image type x y}
	method _double {x y}
    }
    
    private {
        method _configureTags {}

	variable _filterCode ""  ;# Compact view flag.
	variable _hcounter 0     ;# Counter for hierarchy icons
	variable _icons          ;# Array of user icons by uid
	variable _images         ;# Array of our icons by uid
	variable _indents        ;# Array of indentation by uid
	variable _marked         ;# Array of marked nodes by uid
	variable _markers ""     ;# List of markers for level being drawn
	variable _nodes          ;# Array of subnodes by uid
	variable _pending ""     ;# Pending draw flag
	variable _posted ""      ;# List of tags at posted menu position
	variable _selected       ;# Array of selected nodes by uid
	variable _tags           ;# Array of user tags by uid
	variable _text           ;# Array of displayed text by uid
	variable _states         ;# Array of selection state by uid
	variable _ucounter 0     ;# Counter for user icons
    }
}

#
# Provide a lowercased access method for the Hierarchy class.
# 
proc ::iwidgets::hierarchy {pathName args} {
    uplevel ::iwidgets::Hierarchy $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *Hierarchy.menuCursor arrow widgetDefault
option add *Hierarchy.labelPos n widgetDefault
option add *Hierarchy.tabs 30 widgetDefault

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::constructor {args} {
    itk_option remove iwidgets::Labeledwidget::state

    #
    # Our -width and -height options are slightly different than
    # those implemented by our base class, so we're going to
    # remove them and redefine our own.
    #
    itk_option remove iwidgets::Scrolledwidget::width
    itk_option remove iwidgets::Scrolledwidget::height

    #
    # Create a clipping frame which will provide the border for
    # relief display.
    #
    itk_component add clipper {
	frame $itk_interior.clipper
    } {
	usual

	keep -borderwidth -relief -highlightthickness -highlightcolor
	rename -highlightbackground -background background Background
    }	
    grid $itk_component(clipper) -row 0 -column 0 -sticky nsew
    grid rowconfigure $_interior 0 -weight 1
    grid columnconfigure $_interior 0 -weight 1

    #
    # Create a text widget for displaying our hierarchy.
    #
    itk_component add list {
	text $itk_component(clipper).list -wrap none -cursor center_ptr \
                -state disabled -width 1 -height 1 \
	        -xscrollcommand \
		[itcl::code $this _scrollWidget $itk_interior.horizsb] \
		-yscrollcommand \
		[itcl::code $this _scrollWidget $itk_interior.vertsb] \
	        -borderwidth 0 -highlightthickness 0
    } {
	usual

	keep -spacing1 -spacing2 -spacing3 -tabs
	rename -font -textfont textFont Font
	rename -background -textbackground textBackground Background
	ignore -highlightthickness -highlightcolor
	ignore -insertbackground -insertborderwidth
	ignore -insertontime -insertofftime -insertwidth
	ignore -selectborderwidth
	ignore -borderwidth
    }
    grid $itk_component(list) -row 0 -column 0 -sticky nsew
    grid rowconfigure $itk_component(clipper) 0 -weight 1
    grid columnconfigure $itk_component(clipper) 0 -weight 1
    
    # 
    # Configure the command on the vertical scroll bar in the base class.
    #
    $itk_component(vertsb) configure \
	-command [itcl::code $itk_component(list) yview]

    #
    # Configure the command on the horizontal scroll bar in the base class.
    #
    $itk_component(horizsb) configure \
		-command [itcl::code $itk_component(list) xview]
    
    #
    # Configure our text component's tab settings for twenty levels.
    #
    set tabs ""
    for {set i 1} {$i < 20} {incr i} {
	lappend tabs [expr {$i*12+4}]
    }
    $itk_component(list) configure -tabs $tabs

    #
    # Add popup menus that can be configured by the user to add
    # new functionality.
    #
    itk_component add itemMenu {
	menu $itk_component(list).itemmenu -tearoff 0
    } {
	usual
	ignore -tearoff
	rename -cursor -menucursor menuCursor Cursor
    }

    itk_component add bgMenu {
	menu $itk_component(list).bgmenu -tearoff 0
    } {
	usual
	ignore -tearoff
	rename -cursor -menucursor menuCursor Cursor
    }

    #
    # Adjust the bind tags to remove the class bindings.  Also, add
    # bindings for mouse button 1 to do selection and button 3 to 
    # display a popup.
    #
    bindtags $itk_component(list) [list $itk_component(list) . all]
    
    bind $itk_component(list) <ButtonPress-1> \
            [itcl::code $this _select %x %y]

    bind $itk_component(list) <Double-1> \
            [itcl::code $this _double %x %y]

    bind $itk_component(list) <ButtonPress-3> \
            [itcl::code $this _post %x %y]
    
    #
    # Initialize the widget based on the command line options.
    #
    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                           DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::destructor {} {
    if {$_pending != ""} {
	after cancel $_pending
    }
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -font
#
# Font used for text in the list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::font {
    $itk_component(list) tag configure info \
            -font $itk_option(-font) -spacing1 6
}

# ------------------------------------------------------------------
# OPTION: -selectbackground
#
# Background color scheme for selected nodes.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::selectbackground {
    $itk_component(list) tag configure hilite \
            -background $itk_option(-selectbackground)
}

# ------------------------------------------------------------------
# OPTION: -selectforeground
#
# Foreground color scheme for selected nodes.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::selectforeground {
    $itk_component(list) tag configure hilite \
            -foreground $itk_option(-selectforeground)
}

# ------------------------------------------------------------------
# OPTION: -markbackground
#
# Background color scheme for marked nodes.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::markbackground {
    $itk_component(list) tag configure lowlite \
            -background $itk_option(-markbackground)
}

# ------------------------------------------------------------------
# OPTION: -markforeground
#
# Foreground color scheme for marked nodes.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::markforeground {
    $itk_component(list) tag configure lowlite \
            -foreground $itk_option(-markforeground)
}

# ------------------------------------------------------------------
# OPTION: -querycommand
#
# Command executed to query the contents of each node.  If this 
# command contains "%n", it is replaced with the name of the desired 
# node.  In its simpilest form it should return the children of the 
# given node as a list which will be depicted in the display.
#
# Since the names of the children are used as tags in the underlying 
# text widget, each child must be unique in the hierarchy.  Due to
# the unique requirement, the nodes shall be reffered to as uids 
# or uid in the singular sense.
# 
#   {uid [uid ...]}
#
#   where uid is a unique id and primary key for the hierarchy entry
#
# Should the unique requirement pose a problem, the list returned
# can take on another more extended form which enables the 
# association of text to be displayed with the uids.  The uid must
# still be unique, but the text does not have to obey the unique
# rule.  In addition, the format also allows the specification of
# additional tags to be used on the same entry in the hierarchy
# as the uid and additional icons to be displayed just before
# the node.  The tags and icons are considered to be the property of
# the user in that the hierarchy widget will not depend on any of 
# their values.
#
#   {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
#
#   where uid is a unique id and primary key for the hierarchy entry
#         text is the text to be displayed for this uid
#         tags is a list of user tags to be applied to the entry
#         icons is a list of icons to be displayed in front of the text
#
# The hierarchy widget does a look ahead from each node to determine
# if the node has a children.  This can be cost some performace with
# large hierarchies.  User's can avoid this by providing a hint in
# the user tags.  A tag of "leaf" or "branch" tells the hierarchy
# widget the information it needs to know thereby avoiding the look
# ahead operation.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::querycommand {
    clear
    draw -eventually

    # Added for SF ticket #596111
    _configureTags
}

# ------------------------------------------------------------------
# OPTION: -selectcommand
#
# Command executed to select an item in the list.  If this command
# contains "%n", it is replaced with the name of the selected node.  
# If it contains a "%s", it is replaced with a boolean indicator of 
# the node's current selection status, where a value of 1 denotes
# that the node is currently selected and 0 that it is not.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::selectcommand {
}

# ------------------------------------------------------------------
# OPTION: -dblclickcommand
#
# Command executed to double click an item in the list.  If this command
# contains "%n", it is replaced with the name of the selected node.  
# If it contains a "%s", it is replaced with a boolean indicator of 
# the node's current selection status, where a value of 1 denotes
# that the node is currently selected and 0 that it is not.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::dblclickcommand {
}

# ------------------------------------------------------------------
# OPTION: -iconcommand
#
# Command executed upon selection of user icons.  If this command 
# contains "%n", it is replaced with the name of the node the icon
# belongs to.  Should it contain "%i" then the icon name is 
# substituted.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::iconcommand {
}

# ------------------------------------------------------------------
# OPTION: -icondblcommand
#
# Command executed upon double selection of user icons.  If this command 
# contains "%n", it is replaced with the name of the node the icon
# belongs to.  Should it contain "%i" then the icon name is 
# substituted.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::icondblcommand {
}

# ------------------------------------------------------------------
# OPTION: -imagecommand
#
# Command executed upon selection of image icons.  If this command 
# contains "%n", it is replaced with the name of the node the icon
# belongs to.  Should it contain "%i" then the icon name is 
# substituted.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::imagecommand {
}

# ------------------------------------------------------------------
# OPTION: -imagedblcommand
#
# Command executed upon double selection of user icons.  If this command 
# contains "%n", it is replaced with the name of the node the icon
# belongs to.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::imagedblcommand {
}

# ------------------------------------------------------------------
# OPTION: -alwaysquery
#
# Boolean flag which tells the hierarchy widget weather or not
# each refresh of the display should be via a new query using
# the -querycommand option or use the values previous found the
# last time the query was made.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::alwaysquery {
    switch -- $itk_option(-alwaysquery) {
	    1 - true - yes - on {
	        ;# okay
	    }
	    0 - false - no - off {
	        ;# okay
	    }
	    default {
	        error "bad alwaysquery option \"$itk_option(-alwaysquery)\":\
                    should be boolean"
	    }
    }
}

# ------------------------------------------------------------------
# OPTION: -filter
#
# When true only the branch nodes and selected items are displayed.
# This gives a compact view of important items.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::filter {
    switch -- $itk_option(-filter) {
	    1 - true - yes - on {
	        set newCode {set display [info exists _selected($child)]}
	    }
	    0 - false - no - off {
	        set newCode {set display 1}
	    }
	    default {
	        error "bad filter option \"$itk_option(-filter)\":\
                   should be boolean"
	    }
    }
    if {$newCode != $_filterCode} {
	    set _filterCode $newCode
	    draw -eventually
    }
}

# ------------------------------------------------------------------
# OPTION: -expanded
#
# When true, the hierarchy will be completely expanded when it
# is first displayed.  A fresh display can be triggered by
# resetting the -querycommand option.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::expanded {
    switch -- $itk_option(-expanded) {
	    1 - true - yes - on {
	        ;# okay
	    }
	    0 - false - no - off {
	        ;# okay
	    }
	    default {
	        error "bad expanded option \"$itk_option(-expanded)\":\
                   should be boolean"
	    }
    }
}
    
# ------------------------------------------------------------------
# OPTION: -openicon
#
# Specifies the open icon image to be used in the hierarchy.  Should
# one not be provided, then one will be generated, pixmap if 
# possible, bitmap otherwise.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::openicon {
    if {$itk_option(-openicon) == {}} {
	if {[lsearch [image names] openFolder] == -1} {
	    if {[lsearch [image types] pixmap] != -1} {
		image create pixmap openFolder -data {
		    /* XPM */
		    static char * dir_opened [] = {
			"16 16 4 1",
			/* colors */
			". c grey85 m white g4 grey90",
			"b c black  m black g4 black",
			"y c yellow m white g4 grey80",
			"g c grey70 m white g4 grey70",
			/* pixels */
			"................",
			"................",
			"................",
			"..bbbb..........",
			".bggggb.........",
			"bggggggbbbbbbb..",
			"bggggggggggggb..",
			"bgbbbbbbbbbbbbbb",
			"bgbyyyyyyyyyyybb",
			"bbyyyyyyyyyyyyb.",
			"bbyyyyyyyyyyybb.",
			"byyyyyyyyyyyyb..",
			"bbbbbbbbbbbbbb..",
			"................",
			"................",
			"................"};
		}
	    } else {
		image create bitmap openFolder -data {
		    #define open_width 16
		    #define open_height 16
		    static char open_bits[] = {
			0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, 0x42, 0x00, 
			0x81, 0x3f, 0x01, 0x20, 0xf9, 0xff, 0x0d, 0xc0, 
			0x07, 0x40, 0x03, 0x60, 0x01, 0x20, 0x01, 0x30,
			0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
		}
	    }
	}
	set itk_option(-openicon) openFolder
    } else {
	if {[lsearch [image names] $itk_option(-openicon)] == -1} {
	    error "bad openicon option \"$itk_option(-openicon)\":\
                   should be an existing image"
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -closedicon
#
# Specifies the closed icon image to be used in the hierarchy.  
# Should one not be provided, then one will be generated, pixmap if 
# possible, bitmap otherwise.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::closedicon {
    if {$itk_option(-closedicon) == {}} {
	if {[lsearch [image names] closedFolder] == -1} {
	    if {[lsearch [image types] pixmap] != -1} {
		image create pixmap closedFolder -data {
		    /* XPM */
		    static char *dir_closed[] = {
			"16 16 3 1",
			". c grey85 m white g4 grey90",
			"b c black  m black g4 black",
			"y c yellow m white g4 grey80",
			"................",
			"................",
			"................",
			"..bbbb..........",
			".byyyyb.........",
			"bbbbbbbbbbbbbb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"bbbbbbbbbbbbbb..",
			"................",
			"................",
			"................"};	
		}
	    } else {
		image create bitmap closedFolder -data {
		    #define closed_width 16
		    #define closed_height 16
		    static char closed_bits[] = {
			0x00, 0x00, 0x00, 0x00, 0x78, 0x00, 0x84, 0x00, 
			0xfe, 0x7f, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 
			0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
			0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
		}
	    }
	}
	set itk_option(-closedicon) closedFolder
    } else {
	if {[lsearch [image names] $itk_option(-closedicon)] == -1} {
	    error "bad closedicon option \"$itk_option(-closedicon)\":\
                   should be an existing image"
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -nodeicon
#
# Specifies the node icon image to be used in the hierarchy.  Should 
# one not be provided, then one will be generated, pixmap if 
# possible, bitmap otherwise.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::nodeicon {
    if {$itk_option(-nodeicon) == {}} {
	if {[lsearch [image names] nodeFolder] == -1} {
	    if {[lsearch [image types] pixmap] != -1} {
		image create pixmap nodeFolder -data {
		    /* XPM */
		    static char *dir_node[] = {
			"16 16 3 1",
			". c grey85 m white g4 grey90",
			"b c black  m black g4 black",
			"y c yellow m white g4 grey80",
			"................",
			"................",
			"................",
			"...bbbbbbbbbbb..",
			"..bybyyyyyyyyb..",
			".byybyyyyyyyyb..",
			"byyybyyyyyyyyb..",
			"bbbbbyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"byyyyyyyyyyyyb..",
			"bbbbbbbbbbbbbb..",
			"................",
			"................",
			"................"};	
		}
	    } else {
		image create bitmap nodeFolder -data {
		    #define node_width 16
		    #define node_height 16
		    static char node_bits[] = {
			0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x50, 0x40, 
			0x48, 0x40, 0x44, 0x40, 0x42, 0x40, 0x7e, 0x40, 
			0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
			0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
		}
	    }
	}
	set itk_option(-nodeicon) nodeFolder
    } else {
	if {[lsearch [image names] $itk_option(-nodeicon)] == -1} {
	    error "bad nodeicon option \"$itk_option(-nodeicon)\":\
                   should be an existing image"
	}
    }
}

# ------------------------------------------------------------------
# OPTION: -width
#
# Specifies the width of the hierarchy widget as an entire unit.
# The value may be specified in any of the forms acceptable to 
# Tk_GetPixels.  Any additional space needed to display the other
# components such as labels, margins, and scrollbars force the text
# to be compressed.  A value of zero along with the same value for 
# the height causes the value given for the visibleitems option 
# to be applied which administers geometry constraints in a different
# manner.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::width {
    if {$itk_option(-width) != 0} {
	set shell [lindex [grid info $itk_component(clipper)] 1]

	#
	# Due to a bug in the tk4.2 grid, we have to check the 
	# propagation before setting it.  Setting it to the same
	# value it already is will cause it to toggle.
	#
	if {[grid propagate $shell]} {
	    grid propagate $shell no
	}
	
	$itk_component(list) configure -width 1
	$shell configure \
		-width [winfo pixels $shell $itk_option(-width)] 
    } else {
	configure -visibleitems $itk_option(-visibleitems)
    }
}

# ------------------------------------------------------------------
# OPTION: -height
#
# Specifies the height of the hierarchy widget as an entire unit.
# The value may be specified in any of the forms acceptable to 
# Tk_GetPixels.  Any additional space needed to display the other
# components such as labels, margins, and scrollbars force the text
# to be compressed.  A value of zero along with the same value for 
# the width causes the value given for the visibleitems option 
# to be applied which administers geometry constraints in a different
# manner.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::height {
    if {$itk_option(-height) != 0} {
	set shell [lindex [grid info $itk_component(clipper)] 1]

	#
	# Due to a bug in the tk4.2 grid, we have to check the 
	# propagation before setting it.  Setting it to the same
	# value it already is will cause it to toggle.
	#
	if {[grid propagate $shell]} {
	    grid propagate $shell no
	}
	
	$itk_component(list) configure -height 1
	$shell configure \
		-height [winfo pixels $shell $itk_option(-height)] 
    } else {
	configure -visibleitems $itk_option(-visibleitems)
    }
}

# ------------------------------------------------------------------
# OPTION: -visibleitems
#
# Specified the widthxheight in characters and lines for the text.
# This option is only administered if the width and height options
# are both set to zero, otherwise they take precedence.  With the
# visibleitems option engaged, geometry constraints are maintained
# only on the text.  The size of the other components such as 
# labels, margins, and scroll bars, are additive and independent, 
# effecting the overall size of the scrolled text.  In contrast,
# should the width and height options have non zero values, they
# are applied to the scrolled text as a whole.  The text is 
# compressed or expanded to maintain the geometry constraints.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::visibleitems {
    if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} {
	if {($itk_option(-width) == 0) && \
		($itk_option(-height) == 0)} {
	    set chars [lindex [split $itk_option(-visibleitems) x] 0]
	    set lines [lindex [split $itk_option(-visibleitems) x] 1]
	    
	    set shell [lindex [grid info $itk_component(clipper)] 1]

	    #
	    # Due to a bug in the tk4.2 grid, we have to check the 
	    # propagation before setting it.  Setting it to the same
	    # value it already is will cause it to toggle.
	    #
	    if {! [grid propagate $shell]} {
		grid propagate $shell yes
	    }
	    
	    $itk_component(list) configure -width $chars -height $lines
	}
	
    } else {
	error "bad visibleitems option\
		\"$itk_option(-visibleitems)\": should be\
		widthxheight"
    }
}

# ------------------------------------------------------------------
# OPTION: -textmenuloadcommand
#
# Dynamically loads the popup menu based on what was selected.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::textmenuloadcommand {}

# ------------------------------------------------------------------
# OPTION: -imagemenuloadcommand
#
# Dynamically loads the popup menu based on what was selected.
#
# Douglas R. Howard, Jr.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hierarchy::imagemenuloadcommand {}


# ------------------------------------------------------------------
#                         PUBLIC METHODS
# ------------------------------------------------------------------

# ----------------------------------------------------------------------
# PUBLIC METHOD: clear
#
# Removes all items from the display including all tags and icons.  
# The display will remain empty until the -filter or -querycommand 
# options are set.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::clear {} {
    $itk_component(list) configure -state normal -cursor watch
    $itk_component(list) delete 1.0 end
    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)

    # Clear the tags
    eval $itk_component(list) tag delete [$itk_component(list) tag names]
    
    catch {unset _nodes}
    catch {unset _text}
    catch {unset _tags}
    catch {unset _icons}
    catch {unset _states}
    catch {unset _images}
    catch {unset _indents}
    catch {unset _marked}
    catch {unset _selected}
    set _markers  ""
    set _posted   ""
    set _ucounter 0
    set _hcounter 0 

    foreach mark [$itk_component(list) mark names] {
        $itk_component(list) mark unset $mark
    }

    return
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: selection option ?uid uid...?
#
# Handles all operations controlling selections in the hierarchy.
# Selections may be cleared, added, removed, or queried.  The add and
# remove options accept a series of unique ids.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::selection {op args} {
    switch -- $op {
        clear {
            $itk_component(list) tag remove hilite 1.0 end
            catch {unset _selected}
	    return
        }
        add {
            foreach node $args {
                set _selected($node) 1
                catch {
                    $itk_component(list) tag add hilite \
			    "$node.first" "$node.last"
                }
            }
        }
        remove {
            foreach node $args {
                catch {
                    unset _selected($node)
                    $itk_component(list) tag remove hilite \
			    "$node.first" "$node.last"
                }
            }
        }
	get {
	    return [array names _selected]
	}
        default {
            error "bad selection operation \"$op\":\
                   should be add, remove, clear or get"
        }
    }
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: mark option ?arg arg...?
#
# Handles all operations controlling marks in the hierarchy.  Marks may 
# be cleared, added, removed, or queried.  The add and remove options 
# accept a series of unique ids.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::mark {op args} {
    switch -- $op {
        clear {
            $itk_component(list) tag remove lowlite 1.0 end
            catch {unset _marked}
	    return
        }
        add {
            foreach node $args {
                set _marked($node) 1
                catch {
                    $itk_component(list) tag add lowlite \
			    "$node.first" "$node.last"
                }
            }
        }
        remove {
            foreach node $args {
                catch {
                    unset _marked($node)
                    $itk_component(list) tag remove lowlite \
			    "$node.first" "$node.last"
                }
            }
        }
	get {
	    return [array names _marked]
	}
        default {
            error "bad mark operation \"$op\":\
                   should be add, remove, clear or get"
        }
    }
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: current
#
# Returns the node that was most recently selected by the right mouse
# button when the item menu was posted.  Usually used by the code
# in the item menu to figure out what item is being manipulated.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::current {} {
    return $_posted
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: expand node
#
# Expands the hierarchy beneath the specified node.  Since this can take
# a moment for large hierarchies, the cursor will be changed to a watch
# during the expansion.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::expand {node} {
    if {! [info exists _states($node)]} {
	error "bad expand node argument: \"$node\", the node doesn't exist"
    }

    if {!$_states($node) && \
	    (([lsearch $_tags($node) branch] != -1) || \
	     ([llength [_contents $node]] > 0))} {
        $itk_component(list) configure -state normal -cursor watch
        update

	#
	# Get the indentation level for the node.
	#
        set indent $_indents($node)

        set _markers ""
        $itk_component(list) mark set insert "$node:start"
        _drawLevel $node $indent

	#
	# Following the draw, all our markers need adjusting.
	#
        foreach {name index} $_markers {
            $itk_component(list) mark set $name $index
        }

	#
	# Set the image to be the open icon, denote the new state,
	# and set the cursor back to normal along with the state.
	#
	$_images($node) configure -image $itk_option(-openicon)

        set _states($node) 1

        $itk_component(list) configure -state disabled \
		-cursor $itk_option(-cursor)
    }
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: collapse node
#
# Collapses the hierarchy beneath the specified node.  Since this can 
# take a moment for large hierarchies, the cursor will be changed to a 
# watch during the expansion.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::collapse {node} {
    if {! [info exists _states($node)]} {
	error "bad collapse node argument: \"$node\", the node doesn't exist"
    }

    if {[info exists _states($node)] && $_states($node) && \
	    (([lsearch $_tags($node) branch] != -1) || \
	     ([llength [_contents $node]] > 0))} {
        $itk_component(list) configure -state normal -cursor watch
	update

	_deselectSubNodes $node

        $itk_component(list) delete "$node:start" "$node:end"

	catch {$_images($node) configure -image $itk_option(-closedicon)}

        set _states($node) 0

        $itk_component(list) configure -state disabled \
	    -cursor $itk_option(-cursor)
    }
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: toggle node
#
# Toggles the hierarchy beneath the specified node.  If the hierarchy
# is currently expanded, then it is collapsed, and vice-versa.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::toggle {node} {
    if {! [info exists _states($node)]} {
	error "bad toggle node argument: \"$node\", the node doesn't exist"
    }

    if {$_states($node)} {
        collapse $node
    } else {
        expand $node
    }
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: prune node
#
# Removes a particular node from the hierarchy.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::prune {node} {
    #
    # While we're working, change the state and cursor so we can
    # edit the text and give a busy visual clue.
    #
    $itk_component(list) configure -state normal -cursor watch

    #
    # Recursively delete all the subnode information from our internal
    # arrays and remove all the tags.  
    #
    _deleteNodeInfo $node

    #
    # If the mark $node:end exists then the node has decendents so
    # so we'll remove from the mark $node:start to $node:end in order 
    # to delete all the subnodes below it in the text.  
    # 
    if {[lsearch [$itk_component(list) mark names] $node:end] != -1} {
	$itk_component(list) delete $node:start $node:end
	$itk_component(list) mark unset $node:end
    } 

    #
    # Next we need to remove the node itself.  Using the ranges for
    # its tag we'll remove it from line start to the end plus one
    # character which takes us to the start of the next node.
    #
    foreach {start end} [$itk_component(list) tag ranges $node] {
	$itk_component(list) delete "$start linestart" "$end + 1 char"
    }

    #
    # Delete the tag for this node.
    #
    $itk_component(list) tag delete $node

    #
    # The node must be removed from the list of subnodes for its parent.
    # We don't really have a clean way to do upwards referencing, so
    # the dirty way will have to do.  We'll cycle through each node
    # and if this node is in its list of subnodes, we'll remove it.
    #
    foreach uid [array names _nodes] {
	if {[set index [lsearch $_nodes($uid) $node]] != -1} {
	    set _nodes($uid) [lreplace $_nodes($uid) $index $index]
	}
    }

    #
    # We're done, so change the state and cursor back to their 
    # original values.
    #
    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: draw ?when?
#
# Performs a complete draw of the entire hierarchy.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::draw {{when -now}} {
    if {$when == "-eventually"} {
        if {$_pending == ""} {
            set _pending [after idle [itcl::code $this draw -now]]
        }
        return
    } elseif {$when != "-now"} {
        error "bad when option \"$when\": should be -eventually or -now"
    }
    $itk_component(list) configure -state normal -cursor watch
    update

    $itk_component(list) delete 1.0 end
    catch {unset _images}
    set _markers ""

    _drawLevel "" ""

    foreach {name index} $_markers {
        $itk_component(list) mark set $name $index
    }

    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
    set _pending ""
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: refresh node
#
# Performs a redraw of a specific node.  If that node is currently 
# not visible, then no action is taken.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::refresh {node} {
    if {! [info exists _nodes($node)]} {
	error "bad refresh node argument: \"$node\", the node doesn't exist"
    }

    
    if {! $_states($node)} {return}

    foreach parent [_getHeritage $node] {
	if {! $_states($parent)} {return}
    }

    $itk_component(list) configure -state normal -cursor watch
    $itk_component(list) delete $node:start $node:end

    set _markers ""
    $itk_component(list) mark set insert "$node:start"
    set indent $_indents($node)

    _drawLevel $node $indent

    foreach {name index} $_markers {
        $itk_component(list) mark set $name $index
    }

    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
}

# ------------------------------------------------------------------
# THIN WRAPPED TEXT METHODS:
#
# The following methods are thin wraps of standard text methods.
# Consult the Tk text man pages for functionallity and argument
# documentation.
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# PUBLIC METHOD: bbox index
#
# Returns four element list describing the bounding box for the list
# item at index
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::bbox {index} {
    return [$itk_component(list) bbox $index]
}

# ------------------------------------------------------------------
# PUBLIC METHOD compare index1 op index2
#
# Compare indices according to relational operator.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::compare {index1 op index2} {
    return [$itk_component(list) compare $index1 $op $index2]
}

# ------------------------------------------------------------------
# PUBLIC METHOD delete first ?last?
#
# Delete a range of characters from the text.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::delete {first {last {}}} {
    $itk_component(list) configure -state normal -cursor watch
    $itk_component(list) delete $first $last
    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
}

# ------------------------------------------------------------------
# PUBLIC METHOD dump ?switches? index1 ?index2?
#
# Returns information about the contents of the text widget from 
# index1 to index2.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::dump {args} {
    return [eval $itk_component(list) dump $args]
}

# ------------------------------------------------------------------
# PUBLIC METHOD dlineinfo index
#
# Returns a five element list describing the area occupied by the
# display line containing index.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::dlineinfo {index} {
    return [$itk_component(list) dlineinfo $index]
}

# ------------------------------------------------------------------
# PUBLIC METHOD get index1 ?index2?
#
# Return text from start index to end index.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::get {index1 {index2 {}}} {
    return [$itk_component(list) get $index1 $index2]
}

# ------------------------------------------------------------------
# PUBLIC METHOD index index
#
# Return position corresponding to index.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::index {index} {
    return [$itk_component(list) index $index]
}

# ------------------------------------------------------------------
# PUBLIC METHOD insert index chars ?tagList?
#
# Insert text at index.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::insert {args} {
    $itk_component(list) configure -state normal -cursor watch
    eval $itk_component(list) insert $args
    $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
}

# ------------------------------------------------------------------
# PUBLIC METHOD scan option args
#
# Implements scanning on texts.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::scan {option args} {
    eval $itk_component(list) scan $option $args
}

# ------------------------------------------------------------------
# PUBLIC METHOD search ?switches? pattern index ?varName?
#
# Searches the text for characters matching a pattern.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::search {args} {
    return [eval $itk_component(list) search $args]
}

# ------------------------------------------------------------------
# PUBLIC METHOD see index
#
# Adjusts the view in the window so the character at index is 
# visible.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::see {index} {
    $itk_component(list) see $index
}

# ------------------------------------------------------------------
# PUBLIC METHOD tag option ?arg arg ...?
#
# Manipulate tags dependent on options.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::tag {op args} {
    return [eval $itk_component(list) tag $op $args]
}

# ------------------------------------------------------------------
# PUBLIC METHOD window option ?arg arg ...?
#
# Manipulate embedded windows.
# ------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::window {option args} {
    return [eval $itk_component(list) window $option $args]
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: xview args
#
# Thin wrap of the text widget's xview command.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::xview {args} {
    return [eval itk_component(list) xview $args]
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: yview args
#
# Thin wrap of the text widget's yview command.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::yview {args} {
    return [eval $itk_component(list) yview $args]
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: expanded node
#
# Tells if a node is expanded or collapsed
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::expanded {node} {
    if {! [info exists _states($node)]} {
	error "bad collapse node argument: \"$node\", the node doesn't exist"
    }
    
    return $_states($node)
}

# ----------------------------------------------------------------------
# PUBLIC METHOD: expState
#
# Returns a list of all expanded nodes
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::expState {} {
    set nodes [_contents ""]
    set open ""
    set i 0
    while {1} {
	if {[info exists _states([lindex $nodes $i])] &&
	$_states([lindex $nodes $i])} {
	    lappend open [lindex $nodes $i]
	    foreach child [_contents [lindex $nodes $i]] {
		lappend nodes $child
	    }
	}
	incr i
	if {$i >= [llength $nodes]} {break}
    }
    
    return $open
}

# ------------------------------------------------------------------
#                       PROTECTED METHODS
# ------------------------------------------------------------------

# ----------------------------------------------------------------------
# PROTECTED METHOD: _drawLevel node indent
#
# Used internally by draw to draw one level of the hierarchy.
# Draws all of the nodes under node, using the indent string to
# indent nodes.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_drawLevel {node indent} {
    lappend _markers "$node:start" [$itk_component(list) index insert]
    set bg [$itk_component(list) cget -background]

    #
    # Obtain the list of subnodes for this node and cycle through
    # each one displaying it in the hierarchy.
    #
    foreach child [_contents $node] {
	set _images($child) "$itk_component(list).hicon[incr _hcounter]"

        if {![info exists _states($child)]} {
            set _states($child) $itk_option(-expanded)
        }

	#
	# Check the user tags to see if they have been kind enough
	# to tell us ahead of time what type of node we are dealing
	# with branch or leaf.  If they neglected to do so, then
	# get the contents of the child node to see if it has children
	# itself.
	#
	set display 0

	if {[lsearch $_tags($child) leaf] != -1} {
	    set type leaf
	} elseif {[lsearch $_tags($child) branch] != -1} {
	    set type branch
	} else {
	    if {[llength [_contents $child]] == 0} {
		set type leaf
	    } else {
		set type branch
	    }
	}

	#
	# Now that we know the type of node, branch or leaf, we know
	# the type of icon to use.
	#
	if {$type == "leaf"} {
            set icon $itk_option(-nodeicon)
            eval $_filterCode
	} else {
            if {$_states($child)} {
                set icon $itk_option(-openicon)
            } else {
                set icon $itk_option(-closedicon)
            }
            set display 1
	}

	#
	# If display is set then we're going to be drawing this node.
	# Save off the indentation level for this node and do the indent.
	#
	if {$display} {
	    set _indents($child) "$indent\t"
	    $itk_component(list) insert insert $indent

	    #
	    # Add the branch or leaf icon and setup a binding to toggle
	    # its expanded/collapsed state.
	    #
	    label $_images($child) -image $icon -background $bg 
	    # DRH - enhanced and added features that handle image clicking,
	    # double clicking, and right clicking behavior
	    bind $_images($child) <ButtonPress-1> \
	      "[itcl::code $this toggle $child]; [itcl::code $this _imageSelect $child]"
	    bind $_images($child) <Double-1> [itcl::code $this _imageDblClick $child]
	    bind $_images($child) <ButtonPress-3> \
	      [itcl::code $this _imagePost $child $_images($child) $type %x %y]
	    $itk_component(list) window create insert -window $_images($child)

	    #
	    # If any user icons exist then draw them as well.  The little
	    # regexp is just to check and see if they've passed in a
	    # command which needs to be evaluated as opposed to just
	    # a variable.  Also, attach a binding to call them if their
	    # icon is selected.
	    #
	    if {[info exists _icons($child)]} {
		foreach image $_icons($child) {
		    set wid "$itk_component(list).uicon[incr _ucounter]"

		    if {[regexp {\[.*\]} $image]} {
			eval label $wid -image $image -background $bg 
		    } else {
			label $wid -image $image -background $bg 
		    }

		    # DRH - this will bind events to the icons to allow
		    # clicking, double clicking, and right clicking actions.
		    bind $wid <ButtonPress-1> \
			    [itcl::code $this _iconSelect $child $image]
		    bind $wid <Double-1> \
			    [itcl::code $this _iconDblSelect $child $image]
		    bind $wid <ButtonPress-3> \
			    [itcl::code $this _imagePost $child $wid $type %x %y]
		    $itk_component(list) window create insert -window $wid
		}
	    }

	    #
	    # Create the list of tags to be applied to the text.  Start
	    # out with a tag of "info" and append "hilite" if the node
	    # is currently selected, finally add the tags given by the
	    # user.
	    #
	    set texttags [list "info" $child]

	    if {[info exists _selected($child)]} {
		lappend texttags hilite
	    } 

            # The following conditional added for SF ticket #600941.
            if {[info exists _marked($child)]} { 
                lappend texttags lowlite 
            } 

	    foreach tag $_tags($child) {
		lappend texttags $tag
	    }

	    #
	    # Insert the text for the node along with the tags and 
	    # append to the markers the start of this node.  The text
	    # has been broken at newlines into a list.  We'll make sure
	    # that each line is at the same indentation position.
	    #
	    set firstline 1
	    foreach line $_text($child) {
		if {$firstline} {
		    $itk_component(list) insert insert " "
		} else {
		    $itk_component(list) insert insert "$indent\t"
		}

		$itk_component(list) insert insert $line $texttags "\n"
		set firstline 0
	    }

	    $itk_component(list) tag raise $child
	    lappend _markers "$child:start" [$itk_component(list) index insert]

	    #
	    # If the state of the node is open, proceed to draw the next 
	    # node below it in the hierarchy.
	    #
	    if {$_states($child)} {
		_drawLevel $child "$indent\t"
	    }
	}
    }

    lappend _markers "$node:end" [$itk_component(list) index insert]
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _contents uid
#
# Used internally to get the contents of a particular node.  If this
# is the first time the node has been seen or the -alwaysquery
# option is set, the -querycommand code is executed to query the node 
# list, and the list is stored until the next time it is needed.
#
# The querycommand may return not only the list of subnodes for the 
# node but additional information on the tags and icons to be used.  
# The return value must be parsed based on the number of elements in 
# the list where the format is a list of lists:
#
# {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_contents {uid} {
    if {$itk_option(-alwaysquery)} {
    } else {
      if {[info exists _nodes($uid)]} {
          return $_nodes($uid)
      }
    }

    # 
    # Substitute any %n's for the node name whose children we're
    # interested in obtaining.
    #
    set cmd $itk_option(-querycommand)
    regsub -all {%n} $cmd [list $uid] cmd

    set nodeinfolist [uplevel \#0 $cmd]

    #
    # Cycle through the node information returned by the query
    # command determining if additional information such as text,
    # user tags, or user icons have been provided.  For text,
    # break it into a list at any newline characters.
    #
    set _nodes($uid) {}

    foreach nodeinfo $nodeinfolist {
	set subnodeuid [lindex $nodeinfo 0]
	lappend _nodes($uid) $subnodeuid

	set llen [llength $nodeinfo] 

	if {$llen == 0 || $llen > 4} {
	    error "invalid number of elements returned by query\
                       command for node: \"$uid\",\
                       should be uid \[text \[tags \[icons\]\]\]"
	}

	if {$llen == 1} {
	    set _text($subnodeuid) [split $subnodeuid \n]
	} 
	if {$llen > 1} {
	    set _text($subnodeuid) [split [lindex $nodeinfo 1] \n]
	}
	if {$llen > 2} {
	    set _tags($subnodeuid) [lindex $nodeinfo 2]
	} else {
	    set _tags($subnodeuid) unknown
	}
	if {$llen > 3} {
	    set _icons($subnodeuid) [lindex $nodeinfo 3]
	}
    }
		  
    #
    # Return the list of nodes.
    #
    return $_nodes($uid)
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _post x y
#
# Used internally to post the popup menu at the coordinate (x,y)
# relative to the widget.  If (x,y) is on an item, then the itemMenu
# component is posted.  Otherwise, the bgMenu is posted.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_post {x y} {
    set rx [expr {[winfo rootx $itk_component(list)]+$x}]
    set ry [expr {[winfo rooty $itk_component(list)]+$y}]

    set index [$itk_component(list) index @$x,$y]

    #
    # The posted variable will hold the list of tags which exist at
    # this x,y position that will be passed back to the user.  They
    # don't need to know about our internal tags, info, hilite, and
    # lowlite, so remove them from the list.
    # 
    set _posted {}

    foreach tag [$itk_component(list) tag names $index] {
        if {![_isInternalTag $tag]} {
            lappend _posted $tag
        }
    }

    #
    # If we have tags then do the popup at this position.
    #
    if {$_posted != {}} {
	# DRH - here is where the user's function for dynamic popup
	# menu loading is done, if the user has specified to do so with the
	# "-textmenuloadcommand"
	if {$itk_option(-textmenuloadcommand) != {}} {
	    eval $itk_option(-textmenuloadcommand)
	}
	tk_popup $itk_component(itemMenu) $rx $ry
    } else {
	tk_popup $itk_component(bgMenu) $rx $ry
    }
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _imagePost node image type x y
#
# Used internally to post the popup menu at the coordinate (x,y)
# relative to the widget.  If (x,y) is on an image, then the itemMenu
# component is posted.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_imagePost {node image type x y} {
    set rx [expr {[winfo rootx $image]+$x}]
    set ry [expr {[winfo rooty $image]+$y}]

    #
    # The posted variable will hold the list of tags which exist at
    # this x,y position that will be passed back to the user.  They
    # don't need to know about our internal tags, info, hilite, and
    # lowlite, so remove them from the list.
    # 
    set _posted {}

    lappend _posted $node $type

    #
    # If we have tags then do the popup at this position.
    #
    if {$itk_option(-imagemenuloadcommand) != {}} {
	eval $itk_option(-imagemenuloadcommand)
    }
    tk_popup $itk_component(itemMenu) $rx $ry
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _select x y
#
# Used internally to select an item at the coordinate (x,y) relative 
# to the widget.  The command associated with the -selectcommand
# option is execute following % character substitutions.  If %n
# appears in the command, the selected node is substituted.  If %s
# appears, a boolean value representing the current selection state
# will be substituted.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_select {x y} {
    if {$itk_option(-selectcommand) != {}} {
	if {[set seltags [$itk_component(list) tag names @$x,$y]] != {}} {
	    foreach tag $seltags {
		if {![_isInternalTag $tag]} {
		    lappend node $tag
		}
	    }

	    if {[lsearch $seltags "hilite"] == -1} {
		set selectstatus 0
	    } else {
		set selectstatus 1
	    }

	    set cmd $itk_option(-selectcommand)
	    regsub -all {%n} $cmd [lindex $node end] cmd
	    regsub -all {%s} $cmd [list $selectstatus] cmd

	    uplevel #0 $cmd
	}
    }

    return
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _double x y
#
# Used internally to double click an item at the coordinate (x,y) relative 
# to the widget.  The command associated with the -dblclickcommand
# option is execute following % character substitutions.  If %n
# appears in the command, the selected node is substituted.  If %s
# appears, a boolean value representing the current selection state
# will be substituted.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_double {x y} {
    if {$itk_option(-dblclickcommand) != {}} {
	if {[set seltags [$itk_component(list) tag names @$x,$y]] != {}} {
	    foreach tag $seltags {
		if {![_isInternalTag $tag]} {
		    lappend node $tag
		}
	    }

	    if {[lsearch $seltags "hilite"] == -1} {
		set selectstatus 0
	    } else {
		set selectstatus 1
	    }

	    set cmd $itk_option(-dblclickcommand)
	    regsub -all {%n} $cmd [list $node] cmd
	    regsub -all {%s} $cmd [list $selectstatus] cmd

	    uplevel #0 $cmd
	}
    }

    return
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _iconSelect node icon
#
# Used internally to upon selection of user icons.  The -iconcommand
# is executed after substitution of the node for %n and icon for %i.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_iconSelect {node icon} {
    set cmd $itk_option(-iconcommand)
    regsub -all {%n} $cmd [list $node] cmd
    regsub -all {%i} $cmd [list $icon] cmd

    uplevel \#0 $cmd

    return {}
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _iconDblSelect node icon
#
# Used internally to upon double selection of user icons.  The 
# -icondblcommand is executed after substitution of the node for %n and 
# icon for %i.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_iconDblSelect {node icon} {
    if {$itk_option(-icondblcommand) != {}} {
	set cmd $itk_option(-icondblcommand)
	regsub -all {%n} $cmd [list $node] cmd
	regsub -all {%i} $cmd [list $icon] cmd
	
	uplevel \#0 $cmd
    }
    return {}
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _imageSelect node icon
#
# Used internally to upon selection of user icons.  The -imagecommand
# is executed after substitution of the node for %n.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_imageSelect {node} {
    if {$itk_option(-imagecommand) != {}} {
	set cmd $itk_option(-imagecommand)
	regsub -all {%n} $cmd [list $node] cmd
	
	uplevel \#0 $cmd
    }
    return {}
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _imageDblClick node
#
# Used internally to upon double selection of images.  The 
# -imagedblcommand is executed.
#
# Douglas R. Howard, Jr.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_imageDblClick {node} {
    if {$itk_option(-imagedblcommand) != {}} {
	set cmd $itk_option(-imagedblcommand)
	regsub -all {%n} $cmd [list $node] cmd
	
	uplevel \#0 $cmd
    }
    return {}
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _deselectSubNodes uid
#
# Used internally to recursively deselect all the nodes beneath a 
# particular node.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_deselectSubNodes {uid} {
    foreach node $_nodes($uid) {
	if {[array names _selected $node] != {}} {
	    unset _selected($node)
	}
	
	if {[array names _nodes $node] != {}} {
	    _deselectSubNodes $node
	}
    }
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _deleteNodeInfo uid
#
# Used internally to recursively delete all the information about a
# node and its decendents.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_deleteNodeInfo {uid} {
    #
    # Recursively call ourseleves as we go down the hierarchy beneath
    # this node.
    #
    if {[info exists _nodes($uid)]} {
	foreach node $_nodes($uid) {
	    if {[array names _nodes $node] != {}} {
		_deleteNodeInfo $node
	    }
	}
    }

    #
    # Unset any entries in our arrays for the node.
    #
    catch {unset _nodes($uid)}
    catch {unset _text($uid)}
    catch {unset _tags($uid)}
    catch {unset _icons($uid)}
    catch {unset _states($uid)}
    catch {unset _images($uid)}
    catch {unset _indents($uid)}
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _getParent uid
#
# Used internally to determine the parent for a node.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_getParent {uid} {
    foreach node [array names _nodes] {
	if {[set index [lsearch $_nodes($node) $uid]] != -1} {
	    return $node
	}
    }
}

# ----------------------------------------------------------------------
# PROTECTED METHOD: _getHeritage uid
#
# Used internally to determine the list of parents for a node.
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_getHeritage {uid} {
    set parents {}

    if {[set parent [_getParent $uid]] != {}} {
	lappend parents $parent
    }

    return $parents
}

# ----------------------------------------------------------------------
# PROTECTED METHOD (could be proc?): _isInternalTag tag
#
# Used internally to tags not to used for user callback commands
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_isInternalTag {tag} {
   set ii [expr {[lsearch -exact {info hilite lowlite unknown} $tag] != -1}];
   return $ii;
}

# ----------------------------------------------------------------------
# PRIVATE METHOD: _configureTags
#
# This method added to fix SF ticket #596111.  When the -querycommand
# is reset after initial construction, the text component loses its
# tag configuration.  This method resets the hilite, lowlite, and info
# tags.  csmith: 9/5/02
# ----------------------------------------------------------------------
itcl::body iwidgets::Hierarchy::_configureTags {} {
  tag configure hilite -background $itk_option(-selectbackground) \
    -foreground $itk_option(-selectforeground)
  tag configure lowlite -background $itk_option(-markbackground) \
    -foreground $itk_option(-markforeground)
  tag configure info -font $itk_option(-font) -spacing1 6
}

Added library/hyperhelp.itk.

























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
#
# Hyperhelp
# ----------------------------------------------------------------------
# Implements a help facility using html formatted hypertext files.
#
# ----------------------------------------------------------------------
#  AUTHOR: Kris Raney                   EMAIL: kraney@spd.dsccc.com
#
#  @(#) $Id: hyperhelp.itk,v 1.5 2002/03/16 05:26:19 mgbacke Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1996 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software
# and its documentation for any purpose, and without fee or written
# agreement with DSC, is hereby granted, provided that the above copyright
# notice appears in all copies and that both the copyright notice and
# warranty disclaimer below appear in supporting documentation, and that
# the names of DSC Technologies Corporation or DSC Communications
# Corporation not be used in advertising or publicity pertaining to the
# software without specific, written prior permission.
#
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
# SOFTWARE.
# ======================================================================

#
# Acknowledgements:
#
# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his
# help.tcl code from tk inspect.

#
# Default resources.
#
option add *Hyperhelp.width 575 widgetDefault
option add *Hyperhelp.height 450 widgetDefault
option add *Hyperhelp.modality none widgetDefault
option add *Hyperhelp.vscrollMode static widgetDefault
option add *Hyperhelp.hscrollMode static widgetDefault
option add *Hyperhelp.maxHistory 20 widgetDefault

#
# Usual options.
#
itk::usual Hyperhelp {
    keep -activebackground -activerelief -background -borderwidth -cursor \
         -foreground -highlightcolor -highlightthickness \
         -selectbackground -selectborderwidth -selectforeground \
         -textbackground
}
 
# ------------------------------------------------------------------
#                          HYPERHELP
# ------------------------------------------------------------------
itcl::class iwidgets::Hyperhelp {
    inherit iwidgets::Shell

    constructor {args} {}

    itk_option define -topics topics Topics {}
    itk_option define -helpdir helpdir Directory .
    itk_option define -title title Title "Help"
    itk_option define -closecmd closeCmd CloseCmd {}
    itk_option define -maxhistory maxHistory MaxHistory 20

    public variable beforelink {}
    public variable afterlink {}

    public method showtopic {topic}
    public method followlink {link}
    public method forward {}
    public method back {}
    public method updatefeedback {n}

    protected method _readtopic {file {anchorpoint {}}}
    protected method _pageforward {}
    protected method _pageback {}
    protected method _lineforward {}
    protected method _lineback {}
    protected method _fill_go_menu {}

    protected variable _history {}      ;# History list of viewed pages
    protected variable _history_ndx -1  ;# current position in history list
    protected variable _history_len 0   ;# length of history list
    protected variable _histdir -1      ;# direction in history we just came 
                                        ;# from
    protected variable _len 0           ;# length of text to be rendered
    protected variable _file {}         ;# current topic

    private variable _remaining 0       ;# remaining text to be rendered
    private variable _rendering 0       ;# flag - in process of rendering
}

#
# Provide a lowercased access method for the Scrolledlistbox class.
#
proc ::iwidgets::hyperhelp {pathName args} {
    uplevel ::iwidgets::Hyperhelp $pathName $args
}

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::constructor {args} {
    itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady

    #
    # Create a pulldown menu
    #
    itk_component add -private menubar {
      frame $itk_interior.menu -relief raised -bd 2
    } {
      keep -background -cursor
    }
    pack $itk_component(menubar) -side top -fill x

    itk_component add -private topicmb {
      menubutton $itk_component(menubar).topicmb -text "Topics" \
           -menu $itk_component(menubar).topicmb.topicmenu \
           -underline 0 -padx 8 -pady 2
    } {
      keep -background -cursor -font -foreground \
              -activebackground -activeforeground
    }
    pack $itk_component(topicmb) -side left

    itk_component add -private topicmenu {
      menu $itk_component(topicmb).topicmenu -tearoff no
    } {
      keep -background -cursor -font -foreground \
              -activebackground -activeforeground
    }

    itk_component add -private navmb {
      menubutton $itk_component(menubar).navmb -text "Navigate" \
          -menu $itk_component(menubar).navmb.navmenu \
          -underline 0 -padx 8 -pady 2
    } {
      keep -background -cursor -font -foreground \
             -activebackground -activeforeground
    }
    pack $itk_component(navmb) -side left

    itk_component add -private navmenu {
      menu $itk_component(navmb).navmenu -tearoff no
    } {
      keep -background -cursor -font -foreground \
              -activebackground -activeforeground
    }
    set m $itk_component(navmenu)
    $m add command -label "Forward" -underline 0 -state disabled \
         -command [itcl::code $this forward] -accelerator f
    $m add command -label "Back" -underline 0 -state disabled \
         -command [itcl::code $this back] -accelerator b
    $m add cascade -label "Go" -underline 0 -menu $m.go

    itk_component add -private navgo {
      menu $itk_component(navmenu).go -postcommand [itcl::code $this _fill_go_menu]
    } {
      keep -background -cursor -font -foreground \
              -activebackground -activeforeground
    }

    #
    # Create a scrolledhtml object to display help pages
    #
    itk_component add scrtxt {
      iwidgets::scrolledhtml $itk_interior.scrtxt \
           -linkcommand "$this followlink" -feedback "$this updatefeedback"
    } {
        keep    -hscrollmode -vscrollmode -background -textbackground \
                -fontname -fontsize -fixedfont -link \
                -linkhighlight -borderwidth -cursor -sbwidth -scrollmargin \
                -width -height -foreground -highlightcolor -visibleitems \
                -highlightthickness -padx -pady -activerelief \
                -relief -selectbackground -selectborderwidth \
                -selectforeground -setgrid -wrap -unknownimage
    }
    pack $itk_component(scrtxt) -fill both -expand yes

    #
    # Bind shortcut keys
    #
    bind $itk_component(hull) <Key-f> [itcl::code $this forward]
    bind $itk_component(hull) <Key-b> [itcl::code $this back]
    bind $itk_component(hull) <Alt-Right> [itcl::code $this forward]
    bind $itk_component(hull) <Alt-Left> [itcl::code $this back]
    bind $itk_component(hull) <Key-space> [itcl::code $this _pageforward]
    bind $itk_component(hull) <Key-Next> [itcl::code $this _pageforward]
    bind $itk_component(hull) <Key-BackSpace> [itcl::code $this _pageback]
    bind $itk_component(hull) <Key-Prior> [itcl::code $this _pageback]
    bind $itk_component(hull) <Key-Delete> [itcl::code $this _pageback]
    bind $itk_component(hull) <Key-Down> [itcl::code $this _lineforward]
    bind $itk_component(hull) <Key-Up> [itcl::code $this _lineback]

    wm title $itk_component(hull) "Help"

    eval itk_initialize $args
    if {[lsearch -exact $args -closecmd] == -1} {
      configure -closecmd [itcl::code $this deactivate]
    }
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------
 
# ------------------------------------------------------------------
# OPTION: -topics
#
# Specifies the topics to display on the menu. For each topic, there should
# be a file named <helpdir>/<topic>.html
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hyperhelp::topics {
    set m $itk_component(topicmenu)
    $m delete 0 last
    foreach topic $itk_option(-topics) {
      if {[lindex $topic 1] == {} } {
        $m add radiobutton -variable topic \
          -value $topic \
          -label $topic \
          -command [list $this showtopic $topic]
      } else {
        if {[string index [file dirname [lindex $topic 1]] 0] != "/" && \
            [string index [file dirname [lindex $topic 1]] 0] != "~"} {
          set link $itk_option(-helpdir)/[lindex $topic 1]
        } else {
          set link [lindex $topic 1]
        }
        $m add radiobutton -variable topic \
          -value [lindex $topic 0] \
          -label [lindex $topic 0] \
          -command [list $this followlink $link]
      }
    }
    $m add separator
    $m add command -label "Close Help" -underline 0 \
      -command $itk_option(-closecmd)
}

# ------------------------------------------------------------------
# OPTION: -title
#
# Specify the window title.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hyperhelp::title {
    wm title $itk_component(hull) $itk_option(-title)
}

# ------------------------------------------------------------------
# OPTION: -helpdir
#
# Set location of help files
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hyperhelp::helpdir {
    if {[file pathtype $itk_option(-helpdir)] == "relative"} {
      configure -helpdir [file join [pwd] $itk_option(-helpdir)]
    } else {
      set _history {}
      set _history_len 0
      set _history_ndx -1
      $itk_component(navmenu) entryconfig 0 -state disabled
      $itk_component(navmenu) entryconfig 1 -state disabled
      configure -topics $itk_option(-topics)
   }
}

# ------------------------------------------------------------------
# OPTION: -closecmd
#
# Specify the command to execute when close is selected from the menu
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hyperhelp::closecmd {
  $itk_component(topicmenu) entryconfigure last -command $itk_option(-closecmd) 
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: showtopic topic
#
# render text of help topic <topic>. The text is expected to be found in
# <helpdir>/<topic>.html
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::showtopic {topic} {
  if ![regexp {(.*)#(.*)} $topic dummy topicname anchorpart] {
    set topicname $topic
    set anchorpart {}
  }
  if {$topicname == ""} {
    set topicname $_file
    set filepath $_file
  } else {
    set filepath $itk_option(-helpdir)/$topicname.html
  }
  if {[incr _history_ndx] < $itk_option(-maxhistory)} {
    set _history [lrange $_history 0 [expr {$_history_ndx - 1}]]
    set _history_len [expr {$_history_ndx + 1}]
  } else {
    incr _history_ndx -1
    set _history [lrange $_history 1 $_history_ndx]
    set _history_len [expr {$_history_ndx + 1}]
  }
  lappend _history [list $topicname $filepath $anchorpart]
  _readtopic $filepath $anchorpart
}

# ------------------------------------------------------------------
# METHOD: followlink link
#
# Callback for click on a link. Shows new topic.
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::followlink {link} {
  if {[string compare $beforelink ""] != 0} {
    eval $beforelink $link
  }
  if ![regexp {(.*)#(.*)} $link dummy filepart anchorpart] {
    set filepart $link
    set anchorpart {}
  }
  if {$filepart != "" && [string index [file dirname $filepart] 0] != "/" && \
      [string index [file dirname $filepart] 0] != "~"} {
    set filepart [$itk_component(scrtxt) pwd]/$filepart
    set hfile $filepart
  } else {
    set hfile $_file
  }
  incr _history_ndx
  set _history [lrange $_history 0 [expr {$_history_ndx - 1}]]
  set _history_len [expr {$_history_ndx + 1}]
  lappend _history [list [file rootname [file tail $hfile]] $hfile $anchorpart]
  set ret [_readtopic $filepart $anchorpart]
  if {[string compare $afterlink ""] != 0} {
    eval $afterlink $link
  }
  return $ret
}

# ------------------------------------------------------------------
# METHOD: forward
#
# Show topic one forward in history list
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::forward {} {
    if {$_rendering || ($_history_ndx+1) >= $_history_len} return
    incr _history_ndx
    eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end]
}

# ------------------------------------------------------------------
# METHOD: back
#
# Show topic one back in history list
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::back {} {
    if {$_rendering || $_history_ndx <= 0} return
    incr _history_ndx -1
    set _histdir 1
    eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end]
}

# ------------------------------------------------------------------
# METHOD: updatefeedback remaining
#
# Callback from text to update feedback widget
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::updatefeedback {n} {
    if {($_remaining - $n) > .1*$_len} {
      [$itk_interior.feedbackshell childsite].helpfeedback step [expr {$_remaining - $n}]
      update idletasks
      set _remaining $n
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _readtopic 
#
# Read in file, render it in text area, and jump to anchorpoint
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::_readtopic {file {anchorpoint {}}} {
    if {$file != ""} {
        if {[string compare $file $_file] != 0} {
            if {[catch {set f [open $file r]} err]} {
                incr _history_ndx $_histdir
                set _history_len [expr {$_history_ndx + 1}]
                set _histdir -1
                set m $itk_component(navmenu)
                if {($_history_ndx+1) < $_history_len} {
                    $m entryconfig 0 -state normal
                } else {
                    $m entryconfig 0 -state disabled
                }
                if {$_history_ndx > 0} {
                    $m entryconfig 1 -state normal
                } else {
                    $m entryconfig 1 -state disabled
                }
                return
            }
            set _file $file
            set txt [read $f]
            iwidgets::shell $itk_interior.feedbackshell -title \
                    "Rendering HTML" -padx 1 -pady 1
            iwidgets::Feedback [$itk_interior.feedbackshell \
                    childsite].helpfeedback \
            -steps [set _len [string length $txt]] \
                    -labeltext "Rendering HTML" -labelpos n
            pack [$itk_interior.feedbackshell childsite].helpfeedback
            $itk_interior.feedbackshell center $itk_interior
            $itk_interior.feedbackshell activate
            set _remaining $_len
            set _rendering 1
            if {[catch {$itk_component(scrtxt) render $txt [file dirname \
                    $file]} err]} {
                if [regexp "</pre>" $err] {
                    $itk_component(scrtxt) render "<tt>$err</tt>"
                } else {
                    $itk_component(scrtxt) render "<pre>$err</pre>"
                }
            }
            wm title $itk_component(hull) "Help: $file"
            itcl::delete object [$itk_interior.feedbackshell \
                    childsite].helpfeedback
            itcl::delete object $itk_interior.feedbackshell
            set _rendering 0
        }
    }
    set m $itk_component(navmenu)
    if {($_history_ndx+1) < $_history_len} {
        $m entryconfig 0 -state normal
    } else {
        $m entryconfig 0 -state disabled
    }
    if {$_history_ndx > 0} {
        $m entryconfig 1 -state normal
    } else {
        $m entryconfig 1 -state disabled
    }
    if {$anchorpoint != {}} {
        $itk_component(scrtxt) import -link #$anchorpoint
    } else {
        $itk_component(scrtxt) import -link #
    }
    set _histdir -1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _fill_go_menu
#
# update go submenu with current history
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::_fill_go_menu {} {
    set m $itk_component(navgo)
    catch {$m delete 0 last}
    for {set i [expr {$_history_len - 1}]} {$i >= 0} {incr i -1} {
        set topic [lindex [lindex $_history $i] 0]
        set filepath [lindex [lindex $_history $i] 1]
        set anchor [lindex [lindex $_history $i] 2]
        $m add command -label $topic \
                -command [list $this followlink $filepath#$anchor]
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _pageforward
#
# Callback for page forward shortcut key
# -------------------------------------------