Bwidget Source Code
Check-in [25c5681556]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:* images/target.xbm: Placeholder for actual icon.

* color.tcl: Change env(BWIDGET_LIBRARY) to ::BWIDGET::LIBRARY; changed proc "dialogue" to "dialog"

* pkgIndex.tcl: Updated function spec for color.tcl.

* widget.tcl: Various minor speed tweaks; added a reverse mapping from component widget options -> mega-widget options so that subcget can be faster.

* entry.tcl: * dropsite.tcl: * dragsite.tcl: * arrow.tcl: Tcl list'd the specs for Widget::declare calls.

* combobox.tcl: Removed extraneous ListBox::use call.

Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 25c5681556935539f85fb8449b2c056769ac54ac
User & Date: ericm 2000-02-19 02:12:40
Context
2000-02-23
00:32
Fixed a small scrollbar width issue introduced by merge of Boudillier's code. check-in: 40b8a7276c user: ericm tags: trunk
2000-02-19
02:12
* images/target.xbm: Placeholder for actual icon.

* color.tcl: Change env(BWIDGET_LIBRARY) to ::BWIDGET::LIBRARY; changed proc "dialogue" to "dialog"

* pkgIndex.tcl: Updated function spec for color.tcl.

* widget.tcl: Various minor speed tweaks; added a reverse mapping from component widget options -> mega-widget options so that subcget can be faster.

* entry.tcl: * dropsite.tcl: * dragsite.tcl: * arrow.tcl: Tcl list'd the specs for Widget::declare calls.

* combobox.tcl: Removed extraneous ListBox::use call. check-in: 25c5681556 user: ericm tags: trunk

02:07
Additional fixes from Eric Boudaillier. check-in: ac17439246 user: ericm tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.






















1
2
3
4
5
6
7




















2000-02-17  Eric Melski  <[email protected]>

	* notebook.tcl: Added an extra check to move the leftmost tab a
	touch to the right when it is not selected (again, to make the
	tabs more Windows-like).  Also replaced redundant [string equal]
	checks with a stored pre-check (ie, set foo [string equal ...]).

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
2000-02-18  Eric Melski  <[email protected]>

	* images/target.xbm: Placeholder for actual icon.

	* color.tcl: Change env(BWIDGET_LIBRARY) to ::BWIDGET::LIBRARY;
	changed proc "dialogue" to "dialog"

	* pkgIndex.tcl: Updated function spec for color.tcl.

	* widget.tcl: Various minor speed tweaks; added a reverse mapping
	from component widget options -> mega-widget options so that
	subcget can be faster.

	* entry.tcl: 
	* dropsite.tcl: 
	* dragsite.tcl: 
	* arrow.tcl: Tcl list'd the specs for Widget::declare calls.

	* combobox.tcl: Removed extraneous ListBox::use call.
	

2000-02-17  Eric Melski  <[email protected]>

	* notebook.tcl: Added an extra check to move the leftmost tab a
	touch to the right when it is not selected (again, to make the
	tabs more Windows-like).  Also replaced redundant [string equal]
	checks with a stored pre-check (ie, set foo [string equal ...]).

Changes to combobox.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
# ------------------------------------------------------------------------------
#  combobox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: combobox.tcl,v 1.5 2000/02/11 22:54:26 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - ComboBox::create
#     - ComboBox::configure
#     - ComboBox::cget
#     - ComboBox::setvalue
#     - ComboBox::getvalue
................................................................................
#     - ComboBox::_modify_value
# ------------------------------------------------------------------------------

namespace eval ComboBox {
    ArrowButton::use
    Entry::use
    LabelFrame::use
    ListBox::use

    Widget::bwinclude ComboBox LabelFrame .labf \
        rename     {-text -label} \
        remove     {-focus} \
        prefix     {label -justify -width -anchor -height -font} \
        initialize {-relief sunken -borderwidth 2}



|







 







<







1
2
3
4
5
6
7
8
9
10
11
..
16
17
18
19
20
21
22

23
24
25
26
27
28
29
# ------------------------------------------------------------------------------
#  combobox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: combobox.tcl,v 1.6 2000/02/19 02:12:40 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - ComboBox::create
#     - ComboBox::configure
#     - ComboBox::cget
#     - ComboBox::setvalue
#     - ComboBox::getvalue
................................................................................
#     - ComboBox::_modify_value
# ------------------------------------------------------------------------------

namespace eval ComboBox {
    ArrowButton::use
    Entry::use
    LabelFrame::use


    Widget::bwinclude ComboBox LabelFrame .labf \
        rename     {-text -label} \
        remove     {-focus} \
        prefix     {label -justify -width -anchor -height -font} \
        initialize {-relief sunken -borderwidth 2}

Changes to dragsite.tcl.

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
..
37
38
39
40
41
42
43
44
45
46
47
48

49
50
51

52
53
54
55
56
57
58
# ------------------------------------------------------------------------------
#  dragsite.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dragsite.tcl,v 1.2 1999/11/12 04:12:11 sven Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - DragSite::include
#     - DragSite::setdrag
#     - DragSite::register
#     - DragSite::_begin_drag
#     - DragSite::_init_drag
#     - DragSite::_end_drag
#     - DragSite::_update_operation
# ------------------------------------------------------------------------------

namespace eval DragSite {
    Widget::declare DragSite {
        {-dragevent     Enum   1  0 {1 2 3}}
        {-draginitcmd   String "" 0}
        {-dragendcmd    String "" 0}
    }


    variable _topw ".drag"
    variable _tabops
    variable _state
    variable _x0
    variable _y0

................................................................................
}


# ------------------------------------------------------------------------------
#  Command DragSite::include
# ------------------------------------------------------------------------------
proc DragSite::include { class type event } {
    set dragoptions {
        {-dragenabled Boolean 0  0}
        {-draginitcmd String  "" 0}
        {-dragendcmd  String  "" 0}
    }

    lappend dragoptions \
        [list -dragtype  String $type  0] \
        [list -dragevent Enum   $event 0 {1 2 3}]

    Widget::declare $class $dragoptions
}


# ------------------------------------------------------------------------------
#  Command DragSite::setdrag
#  Widget interface to register


|












|
|
|
|
<
>







 







|
|
|
|
<
>
|
<
<
>







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
..
37
38
39
40
41
42
43
44
45
46
47

48
49


50
51
52
53
54
55
56
57
# ------------------------------------------------------------------------------
#  dragsite.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dragsite.tcl,v 1.3 2000/02/19 02:12:40 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - DragSite::include
#     - DragSite::setdrag
#     - DragSite::register
#     - DragSite::_begin_drag
#     - DragSite::_init_drag
#     - DragSite::_end_drag
#     - DragSite::_update_operation
# ------------------------------------------------------------------------------

namespace eval DragSite {
    Widget::declare DragSite [list \
	    [list	-dragevent	Enum	1	0	[list 1 2 3]] \
	    [list	-draginitcmd	String	""	0] \
	    [list	-dragendcmd	String	""	0] \

	    ]

    variable _topw ".drag"
    variable _tabops
    variable _state
    variable _x0
    variable _y0

................................................................................
}


# ------------------------------------------------------------------------------
#  Command DragSite::include
# ------------------------------------------------------------------------------
proc DragSite::include { class type event } {
    set dragoptions [list \
	    [list	-dragenabled	Boolean	0	0] \
	    [list	-draginitcmd	String	""	0] \
	    [list	-dragendcmd	String	""	0] \

	    [list	-dragtype	String	$type	0] \
	    [list	-dragevent	Enum	$event	0	[list 1 2 3]] \


	    ]
    Widget::declare $class $dragoptions
}


# ------------------------------------------------------------------------------
#  Command DragSite::setdrag
#  Widget interface to register

Changes to dropsite.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
# ------------------------------------------------------------------------------
#  dropsite.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dropsite.tcl,v 1.2 1999/11/05 03:38:54 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - DropSite::include
#     - DropSite::setdrop
#     - DropSite::register
#     - DropSite::setcursor
#     - DropSite::setoperation
................................................................................
#     - DropSite::_init_drag
#     - DropSite::_motion
#     - DropSite::_release
# ------------------------------------------------------------------------------


namespace eval DropSite {
    Widget::declare DropSite {
        {-dropovercmd String "" 0}
        {-dropcmd     String "" 0}
        {-droptypes   String "" 0}
    }


    proc use { } {}

    variable _top  ".drag"
    variable _opw  ".drag.\#op"
    variable _target  ""
    variable _status  0
    variable _tabops
    variable _defops
................................................................................
}


# ------------------------------------------------------------------------------
#  Command DropSite::include
# ------------------------------------------------------------------------------
proc DropSite::include { class types } {
    set dropoptions {
        {-dropenabled Boolean 0  0}
        {-dropovercmd String  "" 0}
        {-dropcmd     String  "" 0}
    }
    lappend dropoptions [list -droptypes String $types 0]
    Widget::declare $class $dropoptions
}


# ------------------------------------------------------------------------------
#  Command DropSite::setdrop
#  Widget interface to register


|







 







|
|
|
|
<
|
>
|







 







|
|
|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
..
15
16
17
18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
33
34
35
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
# ------------------------------------------------------------------------------
#  dropsite.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dropsite.tcl,v 1.3 2000/02/19 02:12:40 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - DropSite::include
#     - DropSite::setdrop
#     - DropSite::register
#     - DropSite::setcursor
#     - DropSite::setoperation
................................................................................
#     - DropSite::_init_drag
#     - DropSite::_motion
#     - DropSite::_release
# ------------------------------------------------------------------------------


namespace eval DropSite {
    Widget::declare DropSite [list \
	    [list -dropovercmd String "" 0] \
	    [list -dropcmd     String "" 0] \
	    [list -droptypes   String "" 0] \

	    ]

    proc use {} {}

    variable _top  ".drag"
    variable _opw  ".drag.\#op"
    variable _target  ""
    variable _status  0
    variable _tabops
    variable _defops
................................................................................
}


# ------------------------------------------------------------------------------
#  Command DropSite::include
# ------------------------------------------------------------------------------
proc DropSite::include { class types } {
    set dropoptions [list \
	    [list	-dropenabled	Boolean	0	0] \
	    [list	-dropovercmd	String	""	0] \
	    [list	-dropcmd	String	""	0] \
	    [list	-droptypes	String	$types	0] \
	    ]
    Widget::declare $class $dropoptions
}


# ------------------------------------------------------------------------------
#  Command DropSite::setdrop
#  Widget interface to register

Changes to entry.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
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
# ------------------------------------------------------------------------------
#  entry.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: entry.tcl,v 1.2 2000/02/08 17:48:17 kuchler Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Entry::create
#     - Entry::configure
#     - Entry::cget
#     - Entry::_destroy
#     - Entry::_init_drag_cmd
................................................................................
#     - Entry::_over_cmd
#     - Entry::_auto_scroll
#     - Entry::_scroll
# ------------------------------------------------------------------------------

namespace eval Entry {
    Widget::tkinclude Entry entry :cmd \
        remove {-state -cursor -foreground -textvariable}

    Widget::declare Entry {
        {-foreground         TkResource ""     0 entry}
        {-disabledforeground TkResource ""     0 button}
        {-state              Enum       normal 0 {normal disabled}}
        {-text               String     "" 0}
        {-textvariable       String     "" 0}
        {-editable           Boolean    1  0}
        {-command            String     "" 0}
        {-invalidcommand     String     "" 0 entry}

        {-validate           Enum     none 0 {none focus focusin focusout key all}}
        {-validatecommand    String     "" 0 entry}
        {-relief             TkResource "" 0 entry}
        {-borderwidth        TkResource "" 0 entry}
        {-fg                 Synonym -foreground}
        {-bd                 Synonym -borderwidth}
        {-invcmd             Synonym -invalidcommand}
        {-vcmd               Synonym -validatecommand}
    }



    DynamicHelp::include Entry balloon
    DragSite::include    Entry "" 3
    DropSite::include    Entry {
        TEXT    {move {}}
        FGCOLOR {move {}}
        BGCOLOR {move {}}


|







 







|

|
|
|
|
|
|
|
|
|
>
|
|
<
|
|
|
|
|
<
>
>







1
2
3
4
5
6
7
8
9
10
11
..
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
# ------------------------------------------------------------------------------
#  entry.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: entry.tcl,v 1.3 2000/02/19 02:12:40 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Entry::create
#     - Entry::configure
#     - Entry::cget
#     - Entry::_destroy
#     - Entry::_init_drag_cmd
................................................................................
#     - Entry::_over_cmd
#     - Entry::_auto_scroll
#     - Entry::_scroll
# ------------------------------------------------------------------------------

namespace eval Entry {
    Widget::tkinclude Entry entry :cmd \
	    remove [list -state -cursor -foreground -textvariable]

    Widget::declare Entry [list \
	    [list -foreground		TkResource	""	0 entry] \
	    [list -disabledforeground	TkResource	""	0 button] \
	    [list -state	Enum	normal	0 [list normal disabled]] \
	    [list -text			String	""	0] \
	    [list -textvariable		String	""	0] \
	    [list -editable		Boolean	1	0] \
	    [list -command		String	""	0] \
	    [list -invalidcommand	String	""	0 entry] \
	    [list -validate	Enum	none	0	\
		[list none focus focusin focusout key all]] \
	    [list -validatecommand	String	""	0 entry] \

	    [list -relief		TkResource	""	0 entry] \
	    [list -borderwidth		TkResource	""	0 entry] \
	    [list -fg		Synonym		-foreground] \
	    [list -bd		Synonym		-borderwidth] \
	    [list -invcmd	Synonym		-invalidcommand] \

	    [list -vcmd		Synonym		-validatecommand] \
	    ]

    DynamicHelp::include Entry balloon
    DragSite::include    Entry "" 3
    DropSite::include    Entry {
        TEXT    {move {}}
        FGCOLOR {move {}}
        BGCOLOR {move {}}

Added images/target.xbm.










>
>
>
>
>
1
2
3
4
5
#define minus_width 9
#define minus_height 9
static char minus_bits[] = {
 0xff,0x01,0x01,0x01,0x01,0x01,0x01,0x01,0x7d,0x01,0x01,0x01,0x01,0x01,0x01,
 0x01,0xff,0x01};

Changes to pkgIndex.tcl.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
{dropsite.tcl source {DropSite::register DropSite::include DropSite::use}}
{separator.tcl source {Separator Separator::create Separator::use}}
{spinbox.tcl source {SpinBox SpinBox::create SpinBox::use}}
{titleframe.tcl source {TitleFrame TitleFrame::create TitleFrame::use}}
{mainframe.tcl source {MainFrame MainFrame::create MainFrame::use}}
{listbox.tcl source {ListBox ListBox::create ListBox::use}}
{tree.tcl source {Tree Tree::create Tree::use}}
{color.tcl source {SelectColor SelectColor::create SelectColor::use SelectColor::setcolor}}
{dynhelp.tcl source {DynamicHelp::configure DynamicHelp::use DynamicHelp::register DynamicHelp::include}}
{dialog.tcl source {Dialog Dialog::create Dialog::use}}
{messagedlg.tcl source {MessageDlg MessageDlg::create MessageDlg::use}}
{font.tcl source {SelectFont SelectFont::create SelectFont::use SelectFont::loadfont}}
{widgetdoc.tcl source {Widget::generate-doc Widget::generate-widget-doc}}
{xpm2image.tcl source {xpm-to-image}}
}]; \
	[list namespace eval ::BWIDGET {}]; \
	[list set ::BWIDGET::LIBRARY $dir]; \
    [list source [file join $dir widget.tcl]]; \
    [list source [file join $dir init.tcl]]; \
    [list source [file join $dir utils.tcl]]; \
"






|













24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
{dropsite.tcl source {DropSite::register DropSite::include DropSite::use}}
{separator.tcl source {Separator Separator::create Separator::use}}
{spinbox.tcl source {SpinBox SpinBox::create SpinBox::use}}
{titleframe.tcl source {TitleFrame TitleFrame::create TitleFrame::use}}
{mainframe.tcl source {MainFrame MainFrame::create MainFrame::use}}
{listbox.tcl source {ListBox ListBox::create ListBox::use}}
{tree.tcl source {Tree Tree::create Tree::use}}
{color.tcl source {SelectColor SelectColor::menu SelectColor::dialog}}
{dynhelp.tcl source {DynamicHelp::configure DynamicHelp::use DynamicHelp::register DynamicHelp::include}}
{dialog.tcl source {Dialog Dialog::create Dialog::use}}
{messagedlg.tcl source {MessageDlg MessageDlg::create MessageDlg::use}}
{font.tcl source {SelectFont SelectFont::create SelectFont::use SelectFont::loadfont}}
{widgetdoc.tcl source {Widget::generate-doc Widget::generate-widget-doc}}
{xpm2image.tcl source {xpm-to-image}}
}]; \
	[list namespace eval ::BWIDGET {}]; \
	[list set ::BWIDGET::LIBRARY $dir]; \
    [list source [file join $dir widget.tcl]]; \
    [list source [file join $dir init.tcl]]; \
    [list source [file join $dir utils.tcl]]; \
"

Changes to widget.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
91
92
93
94
95
96
97

98
99
100
101
102
103
104
...
126
127
128
129
130
131
132


133

134
135
136
137
138
139
140
...
181
182
183
184
185
186
187

188
189
190
191
192
193
194
...
216
217
218
219
220
221
222


223

224
225
226
227
228
229
230
...
310
311
312
313
314
315
316

317
318
319
320
321


322

323
324
325
326
327
328
329
...
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
...
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
...
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
...
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
...
723
724
725
726
727
728
729
730
731

732
733
734
735
736
737
738
...
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
# ------------------------------------------------------------------------------
#  widget.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: widget.tcl,v 1.1.1.1 1999/08/03 20:20:23 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Widget::tkinclude
#     - Widget::bwinclude
#     - Widget::declare
#     - Widget::addmap
#     - Widget::init
................................................................................
            }
        }
    }

    namespace eval $class {}
    upvar 0 ${class}::opt classopt
    upvar 0 ${class}::map classmap


    # create resources informations from tk widget resources
    foreach optdesc [_get_tkwidget_options $tkwidget] {
        set option [lindex $optdesc 0]
        if { (![info exists include] || [info exists include($option)]) &&
             ![info exists remove($option)] } {
            if { [llength $optdesc] == 3 } {
................................................................................
                }
                if { [info exists readonly($option)] } {
                    set ro $readonly($option)
                } else {
                    set ro 0
                }
                set classopt($option) [list TkResource $value $ro [list $tkwidget $realopt]]


                lappend classmap($option) $subpath "" $realopt

            }
        }
    }
}


# ------------------------------------------------------------------------------
................................................................................
            }
        }
    }

    namespace eval $class {}
    upvar 0 ${class}::opt classopt
    upvar 0 ${class}::map classmap

    upvar 0 ${subclass}::opt subclassopt

    # create resources informations from BWidget resources
    foreach {option optdesc} [array get subclassopt] {
        if { (![info exists include] || [info exists include($option)]) &&
             ![info exists remove($option)] } {
            set type [lindex $optdesc 0]
................................................................................
                }
                if { [info exists readonly($option)] } {
                    set ro $readonly($option)
                } else {
                    set ro [lindex $optdesc 2]
                }
                set classopt($option) [list $type $value $ro [lindex $optdesc 3]]


                lappend classmap($option) $subpath $subclass $realopt

            }
        }
    }
}


# ------------------------------------------------------------------------------
................................................................................


# ------------------------------------------------------------------------------
#  Command Widget::addmap
# ------------------------------------------------------------------------------
proc Widget::addmap { class subclass subpath options } {
    upvar 0 ${class}::map classmap


    foreach {option realopt} $options {
        if { ![string length $realopt] } {
            set realopt $option
        }


        lappend classmap($option) $subpath $subclass $realopt

    }
}


# ------------------------------------------------------------------------------
#  Command Widget::syncoptions
# ------------------------------------------------------------------------------
................................................................................
}


# ------------------------------------------------------------------------------
#  Command Widget::init
# ------------------------------------------------------------------------------
proc Widget::init { class path options } {
    variable _class
    variable _optiontype

    upvar 0 ${class}::opt classopt
    upvar 0 ${class}::map classmap
    upvar 0 ${class}::$path:opt  pathopt
    upvar 0 ${class}::$path:mod  pathmod


    catch {unset pathopt}


    catch {unset pathmod}

    set fpath ".#BWidgetClass#$class"
    regsub -all "::" $class "" rdbclass

    if { ![winfo exists $fpath] } {
        frame $fpath -class $rdbclass
    }
    foreach {option optdesc} [array get classopt] {
        set type [lindex $optdesc 0]
        if { ![string compare $type "Synonym"] } {
            set option  [lindex $optdesc 1]
................................................................................
            set pathopt($option) $def
        } else {
            set pathopt($option) [lindex $optdesc 1]
        }
        set pathmod($option) 0
    }

    set _class($path) $class
    foreach {option value} $options {
        if { ![info exists classopt($option)] } {
            unset pathopt
            unset pathmod
            return -code error "unknown option \"$option\""
        }
        set optdesc $classopt($option)
        set type    [lindex $optdesc 0]
        if { ![string compare $type "Synonym"] } {
            set option  [lindex $optdesc 1]
            set optdesc $classopt($option)
            set type    [lindex $optdesc 0]
        }
        set pathopt($option) [$_optiontype($type) $option $value [lindex $optdesc 3]]
    }
}


# ------------------------------------------------------------------------------
#  Command Widget::destroy
# ------------------------------------------------------------------------------
................................................................................
}


# ------------------------------------------------------------------------------
#  Command Widget::subcget
# ------------------------------------------------------------------------------
proc Widget::subcget { path subwidget } {
    variable _class

    set class $_class($path)
    upvar 0 ${class}::map classmap
    upvar 0 ${class}::$path:opt pathopt

    set result {}
    foreach {option map} [array get classmap] {
        foreach {subpath subclass realopt} $map {
            if { ![string compare $subpath $subwidget] } {

                lappend result $realopt $pathopt($option)
            }
        }
    }
    return $result
}


# ------------------------------------------------------------------------------
#  Command Widget::hasChanged
................................................................................
}


# ------------------------------------------------------------------------------
#  Command Widget::getoption
# ------------------------------------------------------------------------------
proc Widget::getoption { path option } {
    variable _class

    set class $_class($path)
    upvar 0 ${class}::$path:opt pathopt

    return $pathopt($option)
}


# ------------------------------------------------------------------------------
................................................................................
}


# ------------------------------------------------------------------------------
#  Command Widget::_test_tkresource
# ------------------------------------------------------------------------------
proc Widget::_test_tkresource { option value arg } {
    set tkwidget [lindex $arg 0]
    set realopt  [lindex $arg 1]

    set path     ".#BWidget#$tkwidget"
    set old      [$path cget $realopt]
    $path configure $realopt $value
    set res      [$path cget $realopt]
    $path configure $realopt $old

    return $res
................................................................................
}


# ------------------------------------------------------------------------------
#  Command Widget::_test_string
# ------------------------------------------------------------------------------
proc Widget::_test_string { option value arg } {
    return $value
}


# ------------------------------------------------------------------------------
#  Command Widget::_test_flag
# ------------------------------------------------------------------------------
proc Widget::_test_flag { option value arg } {


|







 







>







 







>
>

>







 







>







 







>
>

>







 







>





>
>

>







 







<
<
<

<



>
|
>
>
|
>

<
>







 







|













|







 







<
<
|
|
|


<
<
<
>
|
<
<







 







<
<
|







 







|
|
>







 







|







1
2
3
4
5
6
7
8
9
10
11
..
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
...
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
...
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
...
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
...
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
...
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
...
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
...
518
519
520
521
522
523
524


525
526
527
528
529



530
531


532
533
534
535
536
537
538
...
566
567
568
569
570
571
572


573
574
575
576
577
578
579
580
...
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
...
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
# ------------------------------------------------------------------------------
#  widget.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: widget.tcl,v 1.2 2000/02/19 02:12:40 ericm Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - Widget::tkinclude
#     - Widget::bwinclude
#     - Widget::declare
#     - Widget::addmap
#     - Widget::init
................................................................................
            }
        }
    }

    namespace eval $class {}
    upvar 0 ${class}::opt classopt
    upvar 0 ${class}::map classmap
    upvar 0 ${class}::map$subpath submap

    # create resources informations from tk widget resources
    foreach optdesc [_get_tkwidget_options $tkwidget] {
        set option [lindex $optdesc 0]
        if { (![info exists include] || [info exists include($option)]) &&
             ![info exists remove($option)] } {
            if { [llength $optdesc] == 3 } {
................................................................................
                }
                if { [info exists readonly($option)] } {
                    set ro $readonly($option)
                } else {
                    set ro 0
                }
                set classopt($option) [list TkResource $value $ro [list $tkwidget $realopt]]
		# Store the forward and backward mappings for this
		# option <-> realoption pair
                lappend classmap($option) $subpath "" $realopt
		set submap($realopt) $option
            }
        }
    }
}


# ------------------------------------------------------------------------------
................................................................................
            }
        }
    }

    namespace eval $class {}
    upvar 0 ${class}::opt classopt
    upvar 0 ${class}::map classmap
    upvar 0 ${class}::map$subpath submap
    upvar 0 ${subclass}::opt subclassopt

    # create resources informations from BWidget resources
    foreach {option optdesc} [array get subclassopt] {
        if { (![info exists include] || [info exists include($option)]) &&
             ![info exists remove($option)] } {
            set type [lindex $optdesc 0]
................................................................................
                }
                if { [info exists readonly($option)] } {
                    set ro $readonly($option)
                } else {
                    set ro [lindex $optdesc 2]
                }
                set classopt($option) [list $type $value $ro [lindex $optdesc 3]]
		# Store the forward and backward mappings for this
		# option <-> realoption pair
                lappend classmap($option) $subpath $subclass $realopt
		set submap($realopt) $option
            }
        }
    }
}


# ------------------------------------------------------------------------------
................................................................................


# ------------------------------------------------------------------------------
#  Command Widget::addmap
# ------------------------------------------------------------------------------
proc Widget::addmap { class subclass subpath options } {
    upvar 0 ${class}::map classmap
    upvar 0 ${class}::map$subpath submap

    foreach {option realopt} $options {
        if { ![string length $realopt] } {
            set realopt $option
        }
	# Store the forward and backward mappings for this
	# option <-> realoption pair
        lappend classmap($option) $subpath $subclass $realopt
	set submap($realopt) $option
    }
}


# ------------------------------------------------------------------------------
#  Command Widget::syncoptions
# ------------------------------------------------------------------------------
................................................................................
}


# ------------------------------------------------------------------------------
#  Command Widget::init
# ------------------------------------------------------------------------------
proc Widget::init { class path options } {



    upvar 0 ${class}::opt classopt

    upvar 0 ${class}::$path:opt  pathopt
    upvar 0 ${class}::$path:mod  pathmod

    if { [info exists pathopt] } {
	unset pathopt
    }
    if { [info exists pathmod] } {
	unset pathmod
    }
    set fpath ".#BWidgetClass#$class"

    set rdbclass [string map [list :: ""] $class]
    if { ![winfo exists $fpath] } {
        frame $fpath -class $rdbclass
    }
    foreach {option optdesc} [array get classopt] {
        set type [lindex $optdesc 0]
        if { ![string compare $type "Synonym"] } {
            set option  [lindex $optdesc 1]
................................................................................
            set pathopt($option) $def
        } else {
            set pathopt($option) [lindex $optdesc 1]
        }
        set pathmod($option) 0
    }

    set Widget::_class($path) $class
    foreach {option value} $options {
        if { ![info exists classopt($option)] } {
            unset pathopt
            unset pathmod
            return -code error "unknown option \"$option\""
        }
        set optdesc $classopt($option)
        set type    [lindex $optdesc 0]
        if { ![string compare $type "Synonym"] } {
            set option  [lindex $optdesc 1]
            set optdesc $classopt($option)
            set type    [lindex $optdesc 0]
        }
        set pathopt($option) [$Widget::_optiontype($type) $option $value [lindex $optdesc 3]]
    }
}


# ------------------------------------------------------------------------------
#  Command Widget::destroy
# ------------------------------------------------------------------------------
................................................................................
}


# ------------------------------------------------------------------------------
#  Command Widget::subcget
# ------------------------------------------------------------------------------
proc Widget::subcget { path subwidget } {


    set class $::Widget::_class($path)
    upvar 0 ${class}::$path:opt pathopt
    upvar 0 ${class}::map$subwidget submap

    set result {}



    foreach realopt [array names submap] {
	lappend result $realopt $pathopt($submap($realopt))


    }
    return $result
}


# ------------------------------------------------------------------------------
#  Command Widget::hasChanged
................................................................................
}


# ------------------------------------------------------------------------------
#  Command Widget::getoption
# ------------------------------------------------------------------------------
proc Widget::getoption { path option } {


    set class $::Widget::_class($path)
    upvar 0 ${class}::$path:opt pathopt

    return $pathopt($option)
}


# ------------------------------------------------------------------------------
................................................................................
}


# ------------------------------------------------------------------------------
#  Command Widget::_test_tkresource
# ------------------------------------------------------------------------------
proc Widget::_test_tkresource { option value arg } {
#    set tkwidget [lindex $arg 0]
#    set realopt  [lindex $arg 1]
    foreach {tkwidget realopt} $arg break
    set path     ".#BWidget#$tkwidget"
    set old      [$path cget $realopt]
    $path configure $realopt $value
    set res      [$path cget $realopt]
    $path configure $realopt $old

    return $res
................................................................................
}


# ------------------------------------------------------------------------------
#  Command Widget::_test_string
# ------------------------------------------------------------------------------
proc Widget::_test_string { option value arg } {
    set value
}


# ------------------------------------------------------------------------------
#  Command Widget::_test_flag
# ------------------------------------------------------------------------------
proc Widget::_test_flag { option value arg } {