Bwidget Source Code
Check-in [8fe69fee99]
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:merge from branch bwidget
Timelines: family | ancestors | descendants | both | patch-75101
Files: files | file ages | folders
SHA3-256: 8fe69fee99a67bacd14dac45dbeff321fb82582e27215ef9ee986fe009aafad9
User & Date: kjnash 2017-10-26 15:22:15
Context
2017-10-28
00:18
REVISIONS TO color.tcl

1. Remove option -variable 2. Remove variable _varName which held the value of option -variable 3. Use variable _unsavedSelection in place of $_varName when a value must be stored 4. Add option -command 5. Add variable _command which holds the value of option -command 6. Set the default value for option -help to 1 7. Add command _userCommand to evaluate $_command at stack level #0. _userCommand is called whenever the selected color changes, i.e. instead of setting $_varName. 8. To avoid issues with trace, fully qualify ::SelectColor::_unsavedSelection when its value is set or it is used in a trace command. 9. Use 8.4-compatible syntax for string indices in "string range" commands. 10. Amend SelectColor::_SetWithoutTrace so it sets the colors in the Color Selectors when the value in the entry widget changes.

PURPOSE Tracing the variable set by the "-variable" option is too awkward in practice, and so the "-variable" option has been replaced with "-command" which allows the caller to specify a command to be executed whenever the selected color changes.

The use of the -command option is now included in the demo.

The properties of DynamicHelp balloon help have been changed in the demo, to make the text easier to read.

The manual page has been updated to reflect the changes in color.tcl. check-in: 9f462bd2fa user: kjnash tags: patch-75101

2017-10-26
15:22
merge from branch bwidget check-in: 8fe69fee99 user: kjnash tags: patch-75101
2017-08-25
07:15
Tagged version 1.9.11 check-in: 02881ab4fd user: oehhar tags: bwidget, bwidget-1-9-11
2013-07-03
08:16
Corrected de.rc line endings and converted no.rc to utf8 check-in: 84ff7343f7 user: oehhar tags: patch-75101
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to BWman/ComboBox.html.

141
142
143
144
145
146
147

148
149
150
151
152
153
154
...
309
310
311
312
313
314
315







316
317
318
319
320
321
322
</DD>
<DD><I>pathName</I> <A HREF="#clearvalue"><B>clearvalue</B></A>
</DD>
<DD><I>pathName</I> <A HREF="#configure"><B>configure</B></A>
 ?<I>option</I>? ?<I>value</I> <I>option</I> <I>value</I> ...?
</DD>
<DD><I>pathName</I> <A HREF="#get"><B>get</B></A></DD>

<DD><I>pathName</I> <A HREF="#getlistbox"><B>getlistbox</B></A></DD>
<DD><I>pathName</I> <A HREF="#getvalue"><B>getvalue</B></A></DD>
<DD><I>pathName</I> <A HREF="#icursor"><B>icursor</B></A>
<I>index</I>
</DD>
<DD><I>pathName</I> <A HREF="#post"><B>post</B></A></DD>
<DD><I>pathName</I> <A HREF="#setvalue"><B>setvalue</B></A>
................................................................................
</DD></DL>

<DL><DT><A NAME="get"><I>pathName</I> <B>get</B></A>
</DT><DD>

Returns the current contents of the entry.








</DD></DL>

<DL><DT><A NAME="getlistbox"><I>pathName</I> <B>getlistbox</B></A>
</DT><DD>

Returns the path to the listbox in the drop down.







>







 







>
>
>
>
>
>
>







141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
...
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
</DD>
<DD><I>pathName</I> <A HREF="#clearvalue"><B>clearvalue</B></A>
</DD>
<DD><I>pathName</I> <A HREF="#configure"><B>configure</B></A>
 ?<I>option</I>? ?<I>value</I> <I>option</I> <I>value</I> ...?
</DD>
<DD><I>pathName</I> <A HREF="#get"><B>get</B></A></DD>
<DD><I>pathName</I> <A HREF="#getentry"><B>getentry</B></A></DD>
<DD><I>pathName</I> <A HREF="#getlistbox"><B>getlistbox</B></A></DD>
<DD><I>pathName</I> <A HREF="#getvalue"><B>getvalue</B></A></DD>
<DD><I>pathName</I> <A HREF="#icursor"><B>icursor</B></A>
<I>index</I>
</DD>
<DD><I>pathName</I> <A HREF="#post"><B>post</B></A></DD>
<DD><I>pathName</I> <A HREF="#setvalue"><B>setvalue</B></A>
................................................................................
</DD></DL>

<DL><DT><A NAME="get"><I>pathName</I> <B>get</B></A>
</DT><DD>

Returns the current contents of the entry.

</DD></DL>

<DL><DT><A NAME="getentry"><I>pathName</I> <B>getentry</B></A>
</DT><DD>

Returns the path to the contained entry widget.

</DD></DL>

<DL><DT><A NAME="getlistbox"><I>pathName</I> <B>getlistbox</B></A>
</DT><DD>

Returns the path to the listbox in the drop down.

Changes to BWman/MainFrame.html.

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
..
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
...
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
</TR>
</TABLE></DD>
</DL>
<DL>
<DT><I><A HREF="#wso">WIDGET-SPECIFIC OPTIONS</A></I></DT>
<DD><TABLE CELLSPACING=0 CELLSPACING=0 BORDER=0>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-casesensitive">-casesensitive</A></TD></TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-height">-height</A></TD></TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-menu">-menu</A></TD>
</TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-separator">-separator</A></TD></TR>
<TR>
................................................................................
<LI>one or more toolbars that user can hide,</LI>
<LI>a status bar, displaying a user message or a menu description, and optionally a
<A HREF="ProgressBar.html">ProgressBar</A>.</LI>
</UL>
</P>
<BR><HR WIDTH="50%"><BR>
<B><A NAME="wso">WIDGET-SPECIFIC OPTIONS</A></B><BR>

<DL><DT><A NAME="-casesensitive"><B>-casesensitive</B></A></DT>
<DD>
Controlls the interpretation of <I>accelerator</I> definition by the <B>-menu</B>
option. If this option is <B>false</B> or not given, the accelerator binding is done
for lowercase letters (no Shift Key pressed) and the accelerator text of the menu entry
is shown in uppercase letters. If it is set to <B>true</B> the accelerator binding
and the menu entry is done as given.
<P>
Example:<BR>
Both accelerators are identically if <B>-casesensitive</B> is specified as false. See
<A HREF="#-menu">-menu</A> for the syntax of the menu discription list.
</P>
<PRE>
...
{command "&Save" {} {Save the document} {<B>Ctrl s</B>} -command Menu::save}
{command "&Save As" {} {Save with different name} {<B>Ctrl S</B>} -command Menu::saveAs}
...
</PRE>
</DD>
</DL>

<DL><DT><A NAME="-height"><B>-height</B></A></DT>
<DD>

Specifies the desired height for the user frame in any of the forms acceptable to
Tk_GetPixels. If this option is less than or equal to zero (the default) then the window
will not request any size at all.
</DD>
................................................................................
<LI><I>tags</I> is the tags list for the entry, used for enabling or disabling menu
entries with <B>MainFrame::setmenustate</B>.</LI>
<LI><I>menuId</I> is an id for the menu, from which you can get menu pathname with
 <B>MainFrame::getmenu</B>.</LI>
<LI><I>tearoff</I> specifies if menu has tearoff entry.</LI>
<LI><I>description</I> specifies a string for <A HREF=\"DynamicHelp.html\">DynamicHelp</A>.</LI>
<LI><I>accelerator</I> specifies a key sequence. It is a list of two elements, where the first
is one of <B>Ctrl</B>, <B>Alt</B> or <B>CtrlAlt</B>, and the second as letter
(see <A HREF="#-casesensitive">-casesensitive</A> option for interpretation),  digit or
a special key name.
An accelerator string is build and corresponding binding set on the toplevel to invoke the
menu entry.</LI>
<LI><I>option value</I> specifies additionnal options for the entry (see <B>menu add</B>
command).</LI>
</UL>






<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|







25
26
27
28
29
30
31


32
33
34
35
36
37
38
..
90
91
92
93
94
95
96






















97
98
99
100
101
102
103
...
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
</TR>
</TABLE></DD>
</DL>
<DL>
<DT><I><A HREF="#wso">WIDGET-SPECIFIC OPTIONS</A></I></DT>
<DD><TABLE CELLSPACING=0 CELLSPACING=0 BORDER=0>
<TR>


<TD>&nbsp;&nbsp;<A HREF="#-height">-height</A></TD></TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-menu">-menu</A></TD>
</TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-separator">-separator</A></TD></TR>
<TR>
................................................................................
<LI>one or more toolbars that user can hide,</LI>
<LI>a status bar, displaying a user message or a menu description, and optionally a
<A HREF="ProgressBar.html">ProgressBar</A>.</LI>
</UL>
</P>
<BR><HR WIDTH="50%"><BR>
<B><A NAME="wso">WIDGET-SPECIFIC OPTIONS</A></B><BR>






















<DL><DT><A NAME="-height"><B>-height</B></A></DT>
<DD>

Specifies the desired height for the user frame in any of the forms acceptable to
Tk_GetPixels. If this option is less than or equal to zero (the default) then the window
will not request any size at all.
</DD>
................................................................................
<LI><I>tags</I> is the tags list for the entry, used for enabling or disabling menu
entries with <B>MainFrame::setmenustate</B>.</LI>
<LI><I>menuId</I> is an id for the menu, from which you can get menu pathname with
 <B>MainFrame::getmenu</B>.</LI>
<LI><I>tearoff</I> specifies if menu has tearoff entry.</LI>
<LI><I>description</I> specifies a string for <A HREF=\"DynamicHelp.html\">DynamicHelp</A>.</LI>
<LI><I>accelerator</I> specifies a key sequence. It is a list of two elements, where the first
is one of <B>Shift</B>, <B>Ctrl</B>, <B>Alt</B>, <B>CtrlAlt</B>, <B>Cmd</B>,  or <B>ShiftCmd</B>, and the second as letter
(see <A HREF="#-casesensitive">-casesensitive</A> option for interpretation),  digit or
a special key name.
An accelerator string is build and corresponding binding set on the toplevel to invoke the
menu entry.</LI>
<LI><I>option value</I> specifies additionnal options for the entry (see <B>menu add</B>
command).</LI>
</UL>

Changes to BWman/MessageDlg.html.

82
83
84
85
86
87
88

89
90
91
92
93
94
95
...
194
195
196
197
198
199
200
201
202
203



204
205
206
207
208
209
210
211
be as wide as it is tall, 200 means the text should
be twice as wide as it is tall, 50 means the text should
be twice as tall as it is wide, and so on.
Used to choose line length for text if <B>width</B> option
isn't specified.
Defaults to 150.


</DD>
</DL>
<DL><DT><A NAME="-buttons"><B>-buttons</B></A></DT>
<DD>

Specifies a list of buttons to display when <B>type</B> option is <I>user</I>.
If a button has a symbolic name, its associated text will be displayed.
................................................................................
Displays three buttons whose symbolic names are <B>yes</B>, <B>no</B>
and <B>cancel</B>.
<P>
<DT>
<B>user</B>
<DD>
Displays buttons of <B>-buttons</B> option.<P>
<DT>
</DL COMPACT>




</DD>
</DL>
<DL><DT><A NAME="-width"><B>-width</B></A></DT>
<DD>

Specifies the length of lines in the window.
If this option has a value greater than zero then the <B>aspect</B>
option is ignored and the <B>width</B> option determines the line






>







 







|
<

>
>
>
|







82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
195
196
197
198
199
200
201
202

203
204
205
206
207
208
209
210
211
212
213
214
be as wide as it is tall, 200 means the text should
be twice as wide as it is tall, 50 means the text should
be twice as tall as it is wide, and so on.
Used to choose line length for text if <B>width</B> option
isn't specified.
Defaults to 150.

The options <B>-width</B> and <B>-aspect</B> are directly heritated from the Tk message widget.
</DD>
</DL>
<DL><DT><A NAME="-buttons"><B>-buttons</B></A></DT>
<DD>

Specifies a list of buttons to display when <B>type</B> option is <I>user</I>.
If a button has a symbolic name, its associated text will be displayed.
................................................................................
Displays three buttons whose symbolic names are <B>yes</B>, <B>no</B>
and <B>cancel</B>.
<P>
<DT>
<B>user</B>
<DD>
Displays buttons of <B>-buttons</B> option.<P>
</DD>


<P>
For any <B>-type</B> but <B>user</B>, the native Tk widget <B>tk_messageBox</B> is used.
In this case, only the following options are considered: <B>-default</B>, <B>-icon</B>, <B>-message</B>, <B>-title</B> and <B>-type</B>.
</P>
</DL>
<DL><DT><A NAME="-width"><B>-width</B></A></DT>
<DD>

Specifies the length of lines in the window.
If this option has a value greater than zero then the <B>aspect</B>
option is ignored and the <B>width</B> option determines the line

Changes to BWman/Widget.html.

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
    usually the first command executed in a new widget definition.
    </p>

<ul>
    <li><i>class</i> is the name of the new widget class.</li>
    <li><i>filename</i> is the name of the file (without extension) in the
    BWidget distribution that defines this class.</li>



</ul>

    <p>
    Each class defined after the filename is a class that this widget
    depends on.  The ::use command will be called for each of these
    classes after the new widget has been defined.
    </p>

    <p>
    This command does several things to setup the new class.  First, it
    creates an alias in the global namespace for the name of the class
    that points to the class's ::create subcommand.  Second, it defines
    a ::use subcommand for the class which other classes can use to load
    this class on the fly.  Lastly, it creates a default binding to the
    &lt;Destroy&gt; event for the class that calls Widget::destroy on
    the path.  This is the default setup for almost all widgets in the
    BWidget package.
    </p>

</DD></DL>

<DL><DT><A NAME="destroy">Widget::<B>destroy</B></A>
 <I>path</I>
</DT><DD>






>
>
>









|
|
|
|
|
|
|
|







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
    usually the first command executed in a new widget definition.
    </p>

<ul>
    <li><i>class</i> is the name of the new widget class.</li>
    <li><i>filename</i> is the name of the file (without extension) in the
    BWidget distribution that defines this class.</li>
    <li><i>?-classonly?</i> If present, the class is not setup.</li>
    <li><i>?-namespace ns?</i> The namespace where the widget's procedures live
    in; defaults to the class name.</li>
</ul>

    <p>
    Each class defined after the filename is a class that this widget
    depends on.  The ::use command will be called for each of these
    classes after the new widget has been defined.
    </p>

    <p>
    If <i>-classonly</i> option is not given this command does several things to
    setup the new class.  First, it creates an alias in the global namespace for
    the name of the class that points to the class's ::create subcommand.
    Second, it defines a ::use subcommand for the class which other classes can
    use to load this class on the fly.  Lastly, it creates a default binding to
    the &lt;Destroy&gt; event for the class that calls Widget::destroy on the
    path.  This is the default setup for almost all widgets in the BWidget
    package.
    </p>

</DD></DL>

<DL><DT><A NAME="destroy">Widget::<B>destroy</B></A>
 <I>path</I>
</DT><DD>

Changes to ChangeLog.

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
2013-08-21 Harald Oehlmann <[email protected]>

	* labelentry.tcl: Bug fixed:
	Methods from Tk entry widget restored [Bug 1002844].
	
	* mainframe.tcl: Allow case sensitive accelerators
	by new option -casesensitive.
	Patch by cmard [Patch 1977644]
	
	* color.tcl: New option -variable allows to give a
	traceable variable with current user color choice.
	New option -background and command SelectColor for
	window background.
	TitleFrames, Dynamic help and Aqua native buttons used.
	Show current choice by highlighting, not focus, to avoid
	conflict with keyboard traversal.
	Shows entry widget for numerical color input/output.
	Patch by Keith J. Nash [Patch 75101]









































































































































































































	
2013-01-09 Harald Oehlmann <[email protected]>

	* widget.tcl: Bug fixed:
	Error 'invalid command name ".#BWidget.#ttk::entry"'
	arises in themed mode when an Entry widget should get
	focus by the tab key.
|
|
<
<
<
<
<
<
<









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







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
2017-##-## ########
	







	* color.tcl: New option -variable allows to give a
	traceable variable with current user color choice.
	New option -background and command SelectColor for
	window background.
	TitleFrames, Dynamic help and Aqua native buttons used.
	Show current choice by highlighting, not focus, to avoid
	conflict with keyboard traversal.
	Shows entry widget for numerical color input/output.
	Patch by Keith J. Nash [Patch 75101]

2017-08-25 Harald Oehlmann <[email protected]>

	**** BWidget 1.9.11 tagged ****

2017-05-08 Harald Oehlmann
	MessageDlg.html: Documented the use of the native widget for
	"MessageDlg -type !user" and the limited set of recognized
	options. Ticket [8edade3cea] by Gerhard Reithofer

2016-10-31 Harald Oehlmann
	scrollframe.tcl: Eric advised to check for unmapped window,
	as the <Map> event may be executed in the unmapped state.

2016-10-31 Harald Oehlmann
	scrollframe.tcl: width changed when unmapped and mapped.
	Checkge the Configure vound proc to not be active when
	currently unmapped. Ticket [72a5727d1b]. Thanks to
	Alexandru for the ticket and patch.

2016-10-31 Harald Oehlmann
	button.tcl: Reverted last change, Eric underlined to
	not use ttk widgets as a base due to the option
	data base. Did traditional fix to exclude all options
	known by button and not known by ttk::button.
	Ticket [845613e5590ae7cf]

2016-08-23 Harald Oehlmann
	button.tcl: configure option of a ::Button gave error in
	themed mode. Ticket [845613e5590ae7cf]. Report by Adrian.

2016-07-21 Harald Oehlmann
	util.tcl: BWidget::place moved away from visible screens
	if the current window is on a virtual screen outside of
	the main screen (Windows multi-screen configuration).
	Ticket [5919a0ec2d]

2016-07-15 Adrian Madrano Calvo
	pckIndex.tcl: auto-load commands also from global namespace
	and not only from BWidget namespace. Ticket [c86207db01]

2016-03-22 Harald Oehlmann <[email protected]>
	Only support themed packages Tile 0.8 or Ttk.
	Repair the button spacing in themed font toolbar.
	Ticket [d7ea07c40a]

2016-03-15 Harald Oehlmann <[email protected]>
	mainframe.tcl: "Mainframe configure" caused error in themed
	mode. Ticket [52273c0a4e]

2016-03-08 Harald Oehlmann <[email protected]>

	**** BWidget 1.9.10 tagged ****

2016-01-07 Adrian Medrano Calvo
	listbox.tcl: Listbox did not scroll to current item on
	startup. Ticket [ae238d5a7]

2016-01-07 Harald Oehlmann <[email protected]>
	lang/da.rc, lang/es.rc, lang/fr.rc, lang/no.rc:
	Translations non portable on utf-8 systems.
	File encoding changed to utf-8. Ticket [6c91e43d76]

2016-01-07 Harald Oehlmann <[email protected]>
	tree.tcl: Tree lines are black by default even if background
	is black. Ticket [ed4c1dab46]

2015-12-08 Harald Oehlmann <[email protected]>
	listbox.tcl: 8.4 compatibility was broken due to the use of
	min/max math functions. Ticket [0aef856302]

2015-11-04 Harald Oehlmann <[email protected]>
	dynhelp.tcl: Drop the assumption that all windows
	screen are the same size (of fix dated 2009-06-26)
	and use the virtual screen information to place the bubble
	help. Ticket [b64e03e548].

2015-10-18 Harald Oehlmann <[email protected]>

	**** BWidget 1.9.9 tagged ****

2015-03-18 Harald Oehlmann <[email protected]>

	widget.tcl: Widget::define got new parameter -namespace,
	allowing megawidget namespace be different to
	class name. This allows lower case namespace names.
	Patch by Adrian Medrano Calvo. Ticket [023a631b20]

2014-09-10 Harald Oehlmann <[email protected]>

	**** BWidget 1.9.8 tagged ****

2014-09-05 Harald Oehlmann <[email protected]>

	widget.tcl: Widget::which errors when option not present.
	Ticket [397db23424]

2014-05-21 Harald Oehlmann <[email protected]>

	widget.tcl: Don't invoke unqualified upvar in callers
	scope. Patch by Adrian Medrano Calvo. Ticket [046fa04231]

	widget.tcl: Don't double creation of temporary widget for
	default values retrieval. Use result of _get_tkwidget_options
	instead. By Adrian Medrano Calvo. Ticket [393b67ab19]

	widget.tcl: New procedure Widget::which (as in [namespace which]),
	that returns the fully qualified name for a widget option or
	widget variable. By Adrian Medrano Calvo. Ticket [a8705e5fd9]

	widget.tcl: Remove unneeded upvar. By Adrian Medrano Calvo.
	Ticket [43f93e0a97]

	widget.tcl et al: remove apparently unused procedure
	Widget::syncoptions and all calls. By Adrian Medrano Calvo.
	Ticket [3c2b8eafc6]


2013-12-13 Harald Oehlmann <[email protected]>

	scrollframe.tcl: Make -constrainedwidth 1 and
	-constrainedheight 1 work together.
	Patch by Simon Bachmann. Ticket [2fa44401d5]

	2013-10-17 Harald Oehlmann <[email protected]>
	widget.tcl: Remove temporary widget.
	By Wolfgang S. Kechel. Ticket [6cd041bcc1]

2013-10-15 Harald Oehlmann <[email protected]>
	combobox.tcl: Themed ComboBox color specifications
	are honored. By Wolfgang S. Kechel. Ticket [6c6704e40f]

2013-10-14 Harald Oehlmann <[email protected]>
	combobox.tcl: Fails in themed mode with "unknown
	option -bg". Patch solves this but listbox items
	are white on white when "-foreground" is specified.
	By Wolfgang S. Kechel. Ticket [6632134ce9]
	
	listbox.tcl: Update on option -deltay added.
	Set x0 to 2 to make highlight work and look nice for
	listbox with image.
	Take image into account to show selection.
	By Wolfgang S. Kechel. Ticket [ff1787af9c]

	scrollw.tcl: Raise scrolled window if it is below in
	the window hierarchy. By Wolfgang S. Kechel.
	Ticket [ff1787af9c]

2013-10-07 Harald Oehlmann <[email protected]>
	dynhelp.tcl: Sometimes the tooltip does not occur under
	gnome/metacity on ubuntu. By Wolfgang S. Kechel.
	Ticket [a588d2f800]

2013-09-15 Harald Oehlmann <[email protected]>

	**** BWidget 1.9.7 tagged ****

2013-09-11 Harald Oehlmann <[email protected]>

	xpm2image.tcl: many issues fixed in xpm import
	by Mattias Hembruch. Ticket [9a8b2ee42e]
	
2013-08-14 Harald Oehlmann <[email protected]>

	* notebook.tcl: cured error in _resize, that
	data($p,width) is not (jet) present. Ticket [a4cbba655d].

2013-06-28 Harald Oehlmann <[email protected]>

	* mainframe.tcl: Included Patch [9f67a66609]
	curing issues of Shift-Accellerators with Shift-Lock
	on Mac. By Keith Nash, Ticket [83ce3e84e7].

2013-06-26 Harald Oehlmann <[email protected]>

	* mainframe.tcl: Reverted Patch [1977644]
	(-casesensitive for accellerators). It has
	issues with shift-lock.

2013-06-21 Harald Oehlmann <[email protected]>

	* labelentry.tcl: Bug fixed:
	Methods from Tk entry widget restored [Bug 1002844].
	
	* mainframe.tcl: Allow case sensitive accelerators
	by new option -casesensitive.
	Patch by cmard [Patch 1977644]
	
	* mainframe.tcl: Allow new modifiers Shift, Cmd and ShiftCmd
	for accelerators. Patch by K.J.Nash [Patch-83ce3e84e7]

	* mainframe.tcl: When changing MainFrame -background, do
	not change menu colors on Aqua.
	Fix by Keith J.Nash [Bug-a81b7afc1e]
	
	* init.tcl: Make loadable in save interpreter.
	Fix by Keith J.Nash [Bug-4365a23bd3]

	* combobox.tcl: Add method getentry to return entry
	widget path for bind purposes.
	Patch by Michael [Patch-2340355]
	
2013-01-09 Harald Oehlmann <[email protected]>

	* widget.tcl: Bug fixed:
	Error 'invalid command name ".#BWidget.#ttk::entry"'
	arises in themed mode when an Entry widget should get
	focus by the tab key.

Changes to button.tcl.

20
21
22
23
24
25
26






27
28
29
30
31
32
33
..
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
namespace eval Button {
    Widget::define Button button DynamicHelp

    set remove [list -command -relief -text -textvariable -underline -state]
    if {[info tclversion] > 8.3} {
	lappend remove -repeatdelay -repeatinterval
    }






    Widget::tkinclude Button button :cmd remove $remove

    Widget::declare Button {
        {-name            String "" 0}
        {-text            String "" 0}
        {-textvariable    String "" 0}
        {-underline       Int    -1 0 "%d >= -1"}
................................................................................
        {-repeatdelay     Int    0  0 "%d >= 0"}
        {-repeatinterval  Int    0  0 "%d >= 0"}
        {-relief          Enum   raised  0 {raised sunken flat ridge solid groove link}}
    }

    DynamicHelp::include Button balloon

    Widget::syncoptions Button "" :cmd {-text {} -underline {}}

    variable _current ""
    variable _pressed ""

    bind BwButton <Enter>           {Button::_enter %W}
    bind BwButton <Leave>           {Button::_leave %W}
    bind BwButton <ButtonPress-1>   {Button::_press %W}
    bind BwButton <ButtonRelease-1> {Button::_release %W}






>
>
>
>
>
>







 







<
<







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
..
44
45
46
47
48
49
50


51
52
53
54
55
56
57
namespace eval Button {
    Widget::define Button button DynamicHelp

    set remove [list -command -relief -text -textvariable -underline -state]
    if {[info tclversion] > 8.3} {
	lappend remove -repeatdelay -repeatinterval
    }
    if {$::Widget::_theme} {
        lappend remove -activebackground -activeforeground -anchor -background\
                -bitmap -borderwidth -disabledforeground -font -foreground\
                -height -highlightbackground -highlightcolor -highlightthickness\
                -justify -overrelief -padx -pady -relief -wraplength
    }
    Widget::tkinclude Button button :cmd remove $remove

    Widget::declare Button {
        {-name            String "" 0}
        {-text            String "" 0}
        {-textvariable    String "" 0}
        {-underline       Int    -1 0 "%d >= -1"}
................................................................................
        {-repeatdelay     Int    0  0 "%d >= 0"}
        {-repeatinterval  Int    0  0 "%d >= 0"}
        {-relief          Enum   raised  0 {raised sunken flat ridge solid groove link}}
    }

    DynamicHelp::include Button balloon



    variable _current ""
    variable _pressed ""

    bind BwButton <Enter>           {Button::_enter %W}
    bind BwButton <Leave>           {Button::_leave %W}
    bind BwButton <ButtonPress-1>   {Button::_press %W}
    bind BwButton <ButtonRelease-1> {Button::_release %W}

Changes to combobox.tcl.

6
7
8
9
10
11
12

13
14
15
16
17
18
19
..
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
...
295
296
297
298
299
300
301
302
303


304
305

306
307
308
309
310
311
312
...
446
447
448
449
450
451
452






























453
454
455
456
457
458
459
...
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
...
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
...
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
#  Index of commands:
#     - ComboBox::create
#     - ComboBox::configure
#     - ComboBox::cget
#     - ComboBox::setvalue
#     - ComboBox::getvalue
#     - ComboBox::clearvalue

#     - ComboBox::_create_popup
#     - ComboBox::_mapliste
#     - ComboBox::_unmapliste
#     - ComboBox::_select
#     - ComboBox::_modify_value
# ----------------------------------------------------------------------------

................................................................................
	}
    } else {
	Widget::addmap ComboBox ArrowButton .a {
	    -background {} -foreground {} -disabledforeground {} -state {}
	}
    }

    Widget::syncoptions ComboBox Entry .e {-text {}}

    ::bind BwComboBox <FocusIn> [list after idle {BWidget::refocus %W %W.e}]
    ::bind BwComboBox <Destroy> [list ComboBox::_destroy %W]

    ::bind ListBoxHotTrack <Motion> {
        %W selection clear 0 end
        %W activate @%x,%y
        %W selection set @%x,%y
................................................................................
    }

    # if the dropdown listbox is shown, simply force the actual entry
    #  colors into it. If it is not shown, the next time the dropdown
    #  is shown it'll get the actual colors anyway
    if {[winfo exists $path.shell.listb]} {
	$path.shell.listb configure \
		-bg [Widget::cget $path -entrybg] \
		-fg [Widget::cget $path -foreground] \


		-selectbackground [Widget::cget $path -selectbackground] \
		-selectforeground [Widget::cget $path -selectforeground]

    }

    return $res
}


# ----------------------------------------------------------------------------
................................................................................
# ----------------------------------------------------------------------------
#  Command ComboBox::clearvalue
# ----------------------------------------------------------------------------
proc ComboBox::clearvalue { path } {
    Entry::configure $path.e -text ""
}































# ----------------------------------------------------------------------------
#  Command ComboBox::_create_popup
# ----------------------------------------------------------------------------
proc ComboBox::_create_popup { path } {
    set shell $path.shell

    if {[winfo exists $shell]} { return }
................................................................................
    set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0]

    if {$bw} {
        if {[Widget::theme]} {
            set listb  [ListBox $shell.listb \
                    -relief flat -borderwidth 0 -highlightthickness 0 \
                    -selectmode single -selectfill 1 -autofocus 0 -height $h \
                    -font [Widget::cget $path -font]  \
                    -bg [Widget::cget $path -entrybg] \
                    -fg [Widget::cget $path -foreground]]
        } else {
            set listb  [ListBox $shell.listb \
                    -relief flat -borderwidth 0 -highlightthickness 0 \
                    -selectmode single -selectfill 1 -autofocus 0 -height $h \
                    -font [Widget::cget $path -font]  \
                    -bg [Widget::cget $path -entrybg] \
                    -fg [Widget::cget $path -foreground] \
                    -selectbackground [Widget::cget $path -selectbackground] \
                    -selectforeground [Widget::cget $path -selectforeground]]
        }

        set values [Widget::cget $path -values]
        set images [Widget::cget $path -images]
        foreach value $values image $images {
................................................................................
    } else {
        if {[Widget::theme]} {
            set listb  [listbox $shell.listb \
                    -relief flat -borderwidth 0 -highlightthickness 0 \
                    -exportselection false \
                    -font	[Widget::cget $path -font]  \
                    -height $h \
                    -bg [Widget::cget $path -entrybg] \
                    -fg [Widget::cget $path -foreground] \
                    -listvariable [Widget::varForOption $path -values]]
        } else {
            set listb  [listbox $shell.listb \
                    -relief flat -borderwidth 0 -highlightthickness 0 \
                    -exportselection false \
                    -font	[Widget::cget $path -font]  \
                    -height $h \
                    -bg [Widget::cget $path -entrybg] \
                    -fg [Widget::cget $path -foreground] \
                    -selectbackground [Widget::cget $path -selectbackground] \
                    -selectforeground [Widget::cget $path -selectforeground] \
                    -listvariable [Widget::varForOption $path -values]]
        }
        ::bind $listb <ButtonRelease-1> [list ComboBox::_select $path @%x,%y]

        if {[Widget::cget $path -hottrack]} {
................................................................................

    set listb $shell.listb
    destroy $shell.sw
    set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0]
    $listb configure \
            -height $h \
            -font   [Widget::cget $path -font] \
            -bg     [Widget::cget $path -entrybg] \
            -fg     [Widget::cget $path -foreground]
    if {![Widget::theme]} {
        $listb configure \
                -selectbackground [Widget::cget $path -selectbackground] \
                -selectforeground [Widget::cget $path -selectforeground]
    }
    pack $sw -fill both -expand yes
    $sw setwidget $listb






>







 







<
<







 







|
|
>
>


>







 







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







 







|
|
|





|
|







 







|
|







|
|







 







|
|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
57
58
59
60
61
62
63


64
65
66
67
68
69
70
...
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
...
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
...
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
...
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
...
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
#  Index of commands:
#     - ComboBox::create
#     - ComboBox::configure
#     - ComboBox::cget
#     - ComboBox::setvalue
#     - ComboBox::getvalue
#     - ComboBox::clearvalue
#     - ComboBox::getentry
#     - ComboBox::_create_popup
#     - ComboBox::_mapliste
#     - ComboBox::_unmapliste
#     - ComboBox::_select
#     - ComboBox::_modify_value
# ----------------------------------------------------------------------------

................................................................................
	}
    } else {
	Widget::addmap ComboBox ArrowButton .a {
	    -background {} -foreground {} -disabledforeground {} -state {}
	}
    }



    ::bind BwComboBox <FocusIn> [list after idle {BWidget::refocus %W %W.e}]
    ::bind BwComboBox <Destroy> [list ComboBox::_destroy %W]

    ::bind ListBoxHotTrack <Motion> {
        %W selection clear 0 end
        %W activate @%x,%y
        %W selection set @%x,%y
................................................................................
    }

    # if the dropdown listbox is shown, simply force the actual entry
    #  colors into it. If it is not shown, the next time the dropdown
    #  is shown it'll get the actual colors anyway
    if {[winfo exists $path.shell.listb]} {
	$path.shell.listb configure \
	    -bg [_getbg $path] \
	    -fg [_getfg $path]
	if {![Widget::theme]} {
	    $path.shell.listb configure \
		-selectbackground [Widget::cget $path -selectbackground] \
		-selectforeground [Widget::cget $path -selectforeground]
	}
    }

    return $res
}


# ----------------------------------------------------------------------------
................................................................................
# ----------------------------------------------------------------------------
#  Command ComboBox::clearvalue
# ----------------------------------------------------------------------------
proc ComboBox::clearvalue { path } {
    Entry::configure $path.e -text ""
}

# ----------------------------------------------------------------------------
#  Command ComboBox::getentry
# ----------------------------------------------------------------------------
proc ComboBox::getentry { path } {
    return $path.e
}

proc ComboBox::_getfg {path} {
    # First try to retrieve option
    set fg [Widget::cget $path -foreground];
    if { 0 == [string length $fg] && [Widget::theme] } {
	# fall back to style settings when not configured for widget
	return [::ttk::style lookup TEntry -foreground];
    }
    return $fg;
}
proc ComboBox::_getbg {path} {
    if {[Widget::theme]} {
	# First try to retrieve option
	set bg [Widget::cget $path -background];
	if {0 == [string length $bg]} {
	    # fall back to style settings when not configured for widget
	    return [::ttk::style lookup TEntry -backround];
	}
    } else {
	# fetch the entrybg resource value
	set bg [Widget::cget $path -entrybg]
    }
    return $bg;
}
# ----------------------------------------------------------------------------
#  Command ComboBox::_create_popup
# ----------------------------------------------------------------------------
proc ComboBox::_create_popup { path } {
    set shell $path.shell

    if {[winfo exists $shell]} { return }
................................................................................
    set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0]

    if {$bw} {
        if {[Widget::theme]} {
            set listb  [ListBox $shell.listb \
                    -relief flat -borderwidth 0 -highlightthickness 0 \
                    -selectmode single -selectfill 1 -autofocus 0 -height $h \
                    -font [Widget::cget $path -font] \
                    -bg [_getbg $path] \
                    -fg [_getfg $path]]
        } else {
            set listb  [ListBox $shell.listb \
                    -relief flat -borderwidth 0 -highlightthickness 0 \
                    -selectmode single -selectfill 1 -autofocus 0 -height $h \
                    -font [Widget::cget $path -font]  \
                    -bg [_getbg $path] \
                    -fg [_getfg $path] \
                    -selectbackground [Widget::cget $path -selectbackground] \
                    -selectforeground [Widget::cget $path -selectforeground]]
        }

        set values [Widget::cget $path -values]
        set images [Widget::cget $path -images]
        foreach value $values image $images {
................................................................................
    } else {
        if {[Widget::theme]} {
            set listb  [listbox $shell.listb \
                    -relief flat -borderwidth 0 -highlightthickness 0 \
                    -exportselection false \
                    -font	[Widget::cget $path -font]  \
                    -height $h \
                    -bg [_getbg $path] \
                    -fg [_getfg $path] \
                    -listvariable [Widget::varForOption $path -values]]
        } else {
            set listb  [listbox $shell.listb \
                    -relief flat -borderwidth 0 -highlightthickness 0 \
                    -exportselection false \
                    -font	[Widget::cget $path -font]  \
                    -height $h \
                    -bg [_getbg $path] \
                    -fg [_getfg $path] \
                    -selectbackground [Widget::cget $path -selectbackground] \
                    -selectforeground [Widget::cget $path -selectforeground] \
                    -listvariable [Widget::varForOption $path -values]]
        }
        ::bind $listb <ButtonRelease-1> [list ComboBox::_select $path @%x,%y]

        if {[Widget::cget $path -hottrack]} {
................................................................................

    set listb $shell.listb
    destroy $shell.sw
    set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0]
    $listb configure \
            -height $h \
            -font   [Widget::cget $path -font] \
            -bg     [_getbg $path] \
            -fg     [_getfg $path]
    if {![Widget::theme]} {
        $listb configure \
                -selectbackground [Widget::cget $path -selectbackground] \
                -selectforeground [Widget::cget $path -selectforeground]
    }
    pack $sw -fill both -expand yes
    $sw setwidget $listb

Changes to dynhelp.tcl.

109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
...
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
#  Command DynamicHelp::sethelp
# ----------------------------------------------------------------------------
proc DynamicHelp::sethelp { path subpath {force 0}} {
    foreach {ctype ctext cvar} [Widget::hasChangedX $path \
	    -helptype -helptext -helpvar] break
    if { $force || $ctype || $ctext || $cvar } {
	set htype [Widget::cget $path -helptype]
        switch $htype {
            balloon {
                return [register $subpath balloon \
			[Widget::cget $path -helptext]]
            }
            variable {
                return [register $subpath variable \
			[Widget::cget $path -helpvar] \
................................................................................
	if {![winfo exists $_top]} {return}

        set  scrwidth  [winfo vrootwidth  .]
        set  scrheight [winfo vrootheight .]
        set  width     [winfo reqwidth  $_top]
        set  height    [winfo reqheight $_top]

        # On windows multi screen configurations, coordinates may get outside
        # the main screen. We suppose that all screens have the same size
        # because it is not possible to query the size of the other screens.
        
        set screenx [expr {$x % $scrwidth} ]
        set screeny [expr {$y % $scrheight} ]

        
        # Increment the required size by the deplacement from the passed point
        incr width 8
        incr height 12
        
        if { $screenx+$width > $scrwidth } {
            set x [expr {$x + ($scrwidth - $screenx) - ($width - 8)}]

        } else {
            incr x 8
        }

        if { $screeny+$height > $scrheight } {
            set y [expr {$y - $height}]
        } else {
            incr y 12
        }

        wm geometry  $_top "+$x+$y"
        update idletasks

	if {![winfo exists $_top]} { return }
        wm deiconify $_top
        raise $_top



    }
}

# ----------------------------------------------------------------------------
#  Command DynamicHelp::_unset_help
# ----------------------------------------------------------------------------
proc DynamicHelp::_unset_help { path } {






|







 







|
|
|
<
<
<
>





|
|
>



>
|











>
>
>







109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
...
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
#  Command DynamicHelp::sethelp
# ----------------------------------------------------------------------------
proc DynamicHelp::sethelp { path subpath {force 0}} {
    foreach {ctype ctext cvar} [Widget::hasChangedX $path \
	    -helptype -helptext -helpvar] break
    if { $force || $ctype || $ctext || $cvar } {
	set htype [Widget::cget $path -helptype]
        switch -- $htype {
            balloon {
                return [register $subpath balloon \
			[Widget::cget $path -helptext]]
            }
            variable {
                return [register $subpath variable \
			[Widget::cget $path -helpvar] \
................................................................................
	if {![winfo exists $_top]} {return}

        set  scrwidth  [winfo vrootwidth  .]
        set  scrheight [winfo vrootheight .]
        set  width     [winfo reqwidth  $_top]
        set  height    [winfo reqheight $_top]

        # On windows multi screen configurations, the virtual screen may start
        # at negative positions.
        set scrrootx [winfo vrootx .]



        set scrrooty [winfo vrooty .]
        
        # Increment the required size by the deplacement from the passed point
        incr width 8
        incr height 12
        
        # Put at the right border if going over it
        if { $x+$width > $scrrootx+$scrwidth } {
            set x [expr {$scrwidth + $scrrootx - $width + 8}]
        } else {
            incr x 8
        }
        # Put above widget if below is no space
        if { $y+$height > $scrrooty+$scrheight } {
            set y [expr {$y - $height}]
        } else {
            incr y 12
        }

        wm geometry  $_top "+$x+$y"
        update idletasks

	if {![winfo exists $_top]} { return }
        wm deiconify $_top
        raise $_top
        # Sometimes the tooltip does not occur under
        # gnome/metacity on ubuntu.
        after 5;
    }
}

# ----------------------------------------------------------------------------
#  Command DynamicHelp::_unset_help
# ----------------------------------------------------------------------------
proc DynamicHelp::_unset_help { path } {

Changes to font.tcl.

280
281
282
283
284
285
286

287
288
289
290
291
292
293
...
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
			 -takefocus 0 -exportselection 0 \
			 -width    4 \
			 -values   $_sizes \
			 -textvariable SelectFont::${path}(size) \
			 -state readonly]
	    bind $lbf <<ComboboxSelected>> [list SelectFont::_update $path]
	    bind $lbs <<ComboboxSelected>> [list SelectFont::_update $path]

	} else {
	    frame $path -background $bg
	    set lbf [ComboBox::create $path.font \
			 -highlightthickness 0 -takefocus 0 -background $bg \
			 -values   $_families($fams) \
			 -textvariable SelectFont::$path\(family\) \
			 -editable 0 \
................................................................................
			 -editable 0 \
			 -modifycmd [list SelectFont::_update $path]]
	}
	bind $path <Destroy> [list SelectFont::_destroy $path]
        pack $lbf -side left -anchor w
        pack $lbs -side left -anchor w -padx 4
        foreach st $_styles {
	    if {$::Widget::_theme} {
		ttk::checkbutton $path.$st -takefocus 0 \
		    -style BWSlim.Toolbutton \
		    -image [Bitmap::get $st] \
		    -variable SelectFont::${path}($st) \
		    -command [list SelectFont::_update $path]
	    } else {
		button $path.$st \






>







 







|







280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
...
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
			 -takefocus 0 -exportselection 0 \
			 -width    4 \
			 -values   $_sizes \
			 -textvariable SelectFont::${path}(size) \
			 -state readonly]
	    bind $lbf <<ComboboxSelected>> [list SelectFont::_update $path]
	    bind $lbs <<ComboboxSelected>> [list SelectFont::_update $path]
	    ttk::style configure BWSlim.Toolbutton -padding 0
	} else {
	    frame $path -background $bg
	    set lbf [ComboBox::create $path.font \
			 -highlightthickness 0 -takefocus 0 -background $bg \
			 -values   $_families($fams) \
			 -textvariable SelectFont::$path\(family\) \
			 -editable 0 \
................................................................................
			 -editable 0 \
			 -modifycmd [list SelectFont::_update $path]]
	}
	bind $path <Destroy> [list SelectFont::_destroy $path]
        pack $lbf -side left -anchor w
        pack $lbs -side left -anchor w -padx 4
        foreach st $_styles {
	    if {[Widget::theme]} {
		ttk::checkbutton $path.$st -takefocus 0 \
		    -style BWSlim.Toolbutton \
		    -image [Bitmap::get $st] \
		    -variable SelectFont::${path}($st) \
		    -command [list SelectFont::_update $path]
	    } else {
		button $path.$st \

Changes to init.tcl.

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
	}
    }
}
Widget::_opt_defaults

# Try to load lang file corresponding to current msgcat locale
proc Widget::_opt_lang {} {
    set langfile [file join $::BWIDGET::LIBRARY "lang" "en.rc"]
    if {0 != [llength [info commands ::msgcat::mcpreferences]]} {
        foreach lang [::msgcat::mcpreferences] {




            set l [file join $::BWIDGET::LIBRARY "lang" "$lang.rc"]
            if {[file readable $l]} {
                set langfile $l


                break
            }
        }
    }
    option read $langfile
}
Widget::_opt_lang

## Add a TraverseIn binding to standard Tk widgets to handle some of
## the BWidget-specific things we do.
bind Entry   <<TraverseIn>> { %W selection range 0 end; %W icursor end }
bind Spinbox <<TraverseIn>> { %W selection range 0 end; %W icursor end }

bind all <Key-Tab>       { Widget::traverseTo [Widget::focusNext %W] }
bind all <<PrevWindow>>  { Widget::traverseTo [Widget::focusPrev %W] }






<

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










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
	}
    }
}
Widget::_opt_defaults

# Try to load lang file corresponding to current msgcat locale
proc Widget::_opt_lang {} {

    if {0 != [llength [info commands ::msgcat::mcpreferences]]} {
        set langs [::msgcat::mcpreferences]
    }
    lappend langs en

    foreach lang $langs {
        set l [file join $::BWIDGET::LIBRARY "lang" "$lang.rc"]


        if {(![catch {file readable $l} result]) && ($result)} {
            option read $l
            break
        }
    }


}
Widget::_opt_lang

## Add a TraverseIn binding to standard Tk widgets to handle some of
## the BWidget-specific things we do.
bind Entry   <<TraverseIn>> { %W selection range 0 end; %W icursor end }
bind Spinbox <<TraverseIn>> { %W selection range 0 end; %W icursor end }

bind all <Key-Tab>       { Widget::traverseTo [Widget::focusNext %W] }
bind all <<PrevWindow>>  { Widget::traverseTo [Widget::focusPrev %W] }

Changes to label.tcl.

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
        IMAGE   {move {}}
        BITMAP  {move {}}
        FGCOLOR {move {}}
        BGCOLOR {move {}}
        COLOR   {move {}}
    }

    Widget::syncoptions Label "" .l {-text {} -underline {}}

    bind BwLabel <FocusIn> [list Label::setfocus %W]
    bind BwLabel <Destroy> [list Label::_destroy %W]
}


# ------------------------------------------------------------------------------
#  Command Label::create






<
<







44
45
46
47
48
49
50


51
52
53
54
55
56
57
        IMAGE   {move {}}
        BITMAP  {move {}}
        FGCOLOR {move {}}
        BGCOLOR {move {}}
        COLOR   {move {}}
    }



    bind BwLabel <FocusIn> [list Label::setfocus %W]
    bind BwLabel <Destroy> [list Label::_destroy %W]
}


# ------------------------------------------------------------------------------
#  Command Label::create

Changes to labelentry.tcl.

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
    Widget::bwinclude LabelEntry Entry .e \
        remove {-fg -bg} \
        rename {-foreground -entryfg -background -entrybg}

    Widget::addmap LabelEntry "" :cmd {-background {}}

    Widget::syncoptions LabelEntry Entry .e {-text {}}
    Widget::syncoptions LabelEntry LabelFrame .labf {-label -text -underline {}}

    ::bind BwLabelEntry <FocusIn> [list focus %W.labf]
    ::bind BwLabelEntry <Destroy> [list LabelEntry::_destroy %W]
}


# ------------------------------------------------------------------------------
#  Command LabelEntry::create






<
<
<







20
21
22
23
24
25
26



27
28
29
30
31
32
33
    Widget::bwinclude LabelEntry Entry .e \
        remove {-fg -bg} \
        rename {-foreground -entryfg -background -entrybg}

    Widget::addmap LabelEntry "" :cmd {-background {}}




    ::bind BwLabelEntry <FocusIn> [list focus %W.labf]
    ::bind BwLabelEntry <Destroy> [list LabelEntry::_destroy %W]
}


# ------------------------------------------------------------------------------
#  Command LabelEntry::create

Changes to labelframe.tcl.

29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
        {-side        Enum       left 1 {left right top bottom}}
        {-bd          Synonym    -borderwidth}
    }

    Widget::addmap LabelFrame "" :cmd {-background {}}
    Widget::addmap LabelFrame "" .f   {-background {} -relief {} -borderwidth {}}

    Widget::syncoptions LabelFrame Label .l {-text {} -underline {}}

    bind BwLabelFrame <FocusIn> [list Label::setfocus %W.l]
    bind BwLabelFrame <Destroy> [list LabelFrame::_destroy %W]
}


# ----------------------------------------------------------------------------
#  Command LabelFrame::create






<
<







29
30
31
32
33
34
35


36
37
38
39
40
41
42
        {-side        Enum       left 1 {left right top bottom}}
        {-bd          Synonym    -borderwidth}
    }

    Widget::addmap LabelFrame "" :cmd {-background {}}
    Widget::addmap LabelFrame "" .f   {-background {} -relief {} -borderwidth {}}



    bind BwLabelFrame <FocusIn> [list Label::setfocus %W.l]
    bind BwLabelFrame <Destroy> [list LabelFrame::_destroy %W]
}


# ----------------------------------------------------------------------------
#  Command LabelFrame::create

Changes to lang/da.rc.

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
!  This file is part of Unifix BWidget Toolkit
!  Definition of Danish resources
! -----------------------------------------------------------------------------


! --- symbolic names of buttons -----------------------------------------------

*abortName:   &Annullr
*retryName:   P&rv igen
*ignoreName:  &Ignorer
*okName:      &OK
*cancelName:  &Cancel
*yesName:     &Ja
*noName:      &Nej


................................................................................
! --- symbolic names of label of SelectFont dialog ----------------------------

*boldName:          Fed
*italicName:        Kursiv
*underlineName:     Understreg
*overstrikeName:    Overstreg
*fontName:          &Font
*sizeName:          &Strrelse
*styleName:         St&il
*colorPickerName:   F&arve...

! --- symbolic names of label of PasswdDlg dialog -----------------------------

*loginName:    &Brugernavn
*passwordName: &Password


! --- resource for SelectFont dialog ------------------------------------------

*SelectFont.title:	    Font-valg
*SelectFont.sampletext:	    Eksempeltekst 


! --- resource for MessageDlg dialog ------------------------------------------

*MessageDlg.noneTitle:      Besked
*MessageDlg.infoTitle:      Information
*MessageDlg.questionTitle:  Sprgsml
*MessageDlg.warningTitle:   Advarsel
*MessageDlg.errorTitle:     Fejl


! --- resource for PasswdDlg dialog -------------------------------------------

*PasswdDlg.title:  Indtast brugernavn og password






|
|







 







|












|






|







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
!  This file is part of Unifix BWidget Toolkit
!  Definition of Danish resources
! -----------------------------------------------------------------------------


! --- symbolic names of buttons -----------------------------------------------

*abortName:   &Annullér
*retryName:   P&røv igen
*ignoreName:  &Ignorer
*okName:      &OK
*cancelName:  &Cancel
*yesName:     &Ja
*noName:      &Nej


................................................................................
! --- symbolic names of label of SelectFont dialog ----------------------------

*boldName:          Fed
*italicName:        Kursiv
*underlineName:     Understreg
*overstrikeName:    Overstreg
*fontName:          &Font
*sizeName:          &Størrelse
*styleName:         St&il
*colorPickerName:   F&arve...

! --- symbolic names of label of PasswdDlg dialog -----------------------------

*loginName:    &Brugernavn
*passwordName: &Password


! --- resource for SelectFont dialog ------------------------------------------

*SelectFont.title:	    Font-valg
*SelectFont.sampletext:	    Eksempeltekst æøå


! --- resource for MessageDlg dialog ------------------------------------------

*MessageDlg.noneTitle:      Besked
*MessageDlg.infoTitle:      Information
*MessageDlg.questionTitle:  Spørgsmål
*MessageDlg.warningTitle:   Advarsel
*MessageDlg.errorTitle:     Fejl


! --- resource for PasswdDlg dialog -------------------------------------------

*PasswdDlg.title:  Indtast brugernavn og password

Changes to lang/es.rc.

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
! --- symbolic names of buttons ------------------------------------------------

*abortName:    A&bortar
*retryName:    &Reintentar
*ignoreName:   &Ignorar
*okName:       &OK
*cancelName:   &Anular
*yesName:      &S 
*noName:       &No

! --- symbolic names of label of SelectFont dialog ----------------------------

*boldName:          &Negrita
*italicName:        &Cursiva
*underlineName:     &Subrayado
*overstrikeName:    &Tachado
*fontName:          &Fuente
*sizeName:          &Tamao
*styleName:         &Estilo
*colorPickerName:   &Color...


! --- symbolic names of label of PasswdDlg dialog -----------------------------

*loginName:    Nombre de &usuario
*passwordName: &Contrasea 

! --- resource for SelectFont dialog ------------------------------------------

*SelectFont.title:        Seleccin de fuente
*SelectFont.sampletext:   Texto de Ejemplo


! --- resource for MessageDlg dialog ------------------------------------------

*MessageDlg.noneTitle:      Indicacin
*MessageDlg.infoTitle:      Informacin
*MessageDlg.questionTitle:  Pregunta
*MessageDlg.warningTitle:   Atencin
*MessageDlg.errorTitle:     Error


! --- resource for PasswdDlg dialog -------------------------------------------

*PasswdDlg.title:  Introduzca su nombre de usuario y contrasea

! --- symbolic names of label of SelectColor dialog ----------------------------

*baseColorsName: Base colors
*userColorsName: User colors

*yourSelectionName: Your Selection






|









|







|



|





|
|

|





|







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
! --- symbolic names of buttons ------------------------------------------------

*abortName:    A&bortar
*retryName:    &Reintentar
*ignoreName:   &Ignorar
*okName:       &OK
*cancelName:   &Anular
*yesName:      &Sí 
*noName:       &No

! --- symbolic names of label of SelectFont dialog ----------------------------

*boldName:          &Negrita
*italicName:        &Cursiva
*underlineName:     &Subrayado
*overstrikeName:    &Tachado
*fontName:          &Fuente
*sizeName:          &Tamaño
*styleName:         &Estilo
*colorPickerName:   &Color...


! --- symbolic names of label of PasswdDlg dialog -----------------------------

*loginName:    Nombre de &usuario
*passwordName: &Contraseña 

! --- resource for SelectFont dialog ------------------------------------------

*SelectFont.title:        Selección de fuente
*SelectFont.sampletext:   Texto de Ejemplo


! --- resource for MessageDlg dialog ------------------------------------------

*MessageDlg.noneTitle:      Indicación
*MessageDlg.infoTitle:      Información
*MessageDlg.questionTitle:  Pregunta
*MessageDlg.warningTitle:   Atención
*MessageDlg.errorTitle:     Error


! --- resource for PasswdDlg dialog -------------------------------------------

*PasswdDlg.title:  Introduzca su nombre de usuario y contraseña

! --- symbolic names of label of SelectColor dialog ----------------------------

*baseColorsName: Base colors
*userColorsName: User colors

*yourSelectionName: Your Selection

Changes to lang/fr.rc.

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
!  Definition of french resources
! ------------------------------------------------------------------------------


! --- symbolic names of buttons ------------------------------------------------

*abortName:    A&bandonner
*retryName:    &Ressayer
*ignoreName:   &Ignorer
*okName:       &OK
*cancelName:   &Annuler
*yesName:      &Oui
*noName:       &Non

! --- symbolic names of label of SelectFont dialog ----------------------------

*boldName:          &Gras
*italicName:        &Italique
*underlineName:     &Soulign
*overstrikeName:    &Barr
*fontName:          &Police
*sizeName:          &Taille
*styleName:         St&yle
*colorPickerName:   &Couleur...


! --- symbolic names of label of PasswdDlg dialog -----------------------------
................................................................................

*loginName:    Nom de l'&utilisateur
*passwordName: Mot de &passe


! --- resource for SelectFont dialog ------------------------------------------

*SelectFont.title:        Slection d'une police
*SelectFont.sampletext:	  Texte d'exemple


! --- resource for MessageDlg dialog ------------------------------------------

*MessageDlg.noneTitle:      Message
*MessageDlg.infoTitle:      Information






|










|
|







 







|







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
!  Definition of french resources
! ------------------------------------------------------------------------------


! --- symbolic names of buttons ------------------------------------------------

*abortName:    A&bandonner
*retryName:    &Réessayer
*ignoreName:   &Ignorer
*okName:       &OK
*cancelName:   &Annuler
*yesName:      &Oui
*noName:       &Non

! --- symbolic names of label of SelectFont dialog ----------------------------

*boldName:          &Gras
*italicName:        &Italique
*underlineName:     &Souligné
*overstrikeName:    &Barré
*fontName:          &Police
*sizeName:          &Taille
*styleName:         St&yle
*colorPickerName:   &Couleur...


! --- symbolic names of label of PasswdDlg dialog -----------------------------
................................................................................

*loginName:    Nom de l'&utilisateur
*passwordName: Mot de &passe


! --- resource for SelectFont dialog ------------------------------------------

*SelectFont.title:        Sélection d'une police
*SelectFont.sampletext:	  Texte d'exemple


! --- resource for MessageDlg dialog ------------------------------------------

*MessageDlg.noneTitle:      Message
*MessageDlg.infoTitle:      Information

Changes to lang/hu.rc.

53
54
55
56
57
58
59

60
61
62
63
64
65
66
67
68
69
70
71
*PasswdDlg.title:  Add meg a felhasználónevet és a jelszót


! --- symbolic names of label of SelectColor dialog ----------------------------

*baseColorsName: Alapszínek
*userColorsName: Felhasználói színek


*yourSelectionName: Your Selection
*colorSelectorsName: Color Selectors
*hoverHelpName: Hover for help with color selection by:
*mouseHelpName: Mouse
*keyboardHelpName: Keyboard

! --- dynamic help text for SelectColor dialog.  Lines 75 chars max, split by '\n'.

*mouseHelpTextName: Click or drag the mouse in the Color Selectors to choose a color.\nIf the selected color remains black, regardless of what you\ndo in the left-hand Color Selector (for hue and saturation), check\nthe position of the pointer in the right-hand Color Selector\n(for brightness).\n\nClick one of the "Base colors" to read a value from this palette.\n\nClick one of the "User colors" to read a value from this palette,\nor to write to the palette if the color is blank.  If you then\nuse the Color Selectors to change the color, your choice will be\nwritten to this (User) palette color until you select another\n(Base or User) palette color.

*keyboardHelpTextName: Click in the text entry window in the left of the "Your\nSelection" area.\n\nType the color that you want in hexadecimal RGB format.\nWhenever the number of hexadecimal digits is a multiple\nof 3, the color value is valid and will be copied to the\nother parts of the Color Selector.\n\nLeave the text entry window by clicking anywhere else,\nor by pressing the "Escape" or "Return" key.  The text\nentry window will then display the color in 24-bit RGB\nformat, although internally the Color Selector uses\n48-bit colors.\n\nWhen the text entry widget does not have keyboard focus\n(i.e. does not show a cursor), the "Return" and "Escape"\nkeys do the same as the "OK" and "Cancel" buttons,\nrespectively.






>












53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
*PasswdDlg.title:  Add meg a felhasználónevet és a jelszót


! --- symbolic names of label of SelectColor dialog ----------------------------

*baseColorsName: Alapszínek
*userColorsName: Felhasználói színek


*yourSelectionName: Your Selection
*colorSelectorsName: Color Selectors
*hoverHelpName: Hover for help with color selection by:
*mouseHelpName: Mouse
*keyboardHelpName: Keyboard

! --- dynamic help text for SelectColor dialog.  Lines 75 chars max, split by '\n'.

*mouseHelpTextName: Click or drag the mouse in the Color Selectors to choose a color.\nIf the selected color remains black, regardless of what you\ndo in the left-hand Color Selector (for hue and saturation), check\nthe position of the pointer in the right-hand Color Selector\n(for brightness).\n\nClick one of the "Base colors" to read a value from this palette.\n\nClick one of the "User colors" to read a value from this palette,\nor to write to the palette if the color is blank.  If you then\nuse the Color Selectors to change the color, your choice will be\nwritten to this (User) palette color until you select another\n(Base or User) palette color.

*keyboardHelpTextName: Click in the text entry window in the left of the "Your\nSelection" area.\n\nType the color that you want in hexadecimal RGB format.\nWhenever the number of hexadecimal digits is a multiple\nof 3, the color value is valid and will be copied to the\nother parts of the Color Selector.\n\nLeave the text entry window by clicking anywhere else,\nor by pressing the "Escape" or "Return" key.  The text\nentry window will then display the color in 24-bit RGB\nformat, although internally the Color Selector uses\n48-bit colors.\n\nWhen the text entry widget does not have keyboard focus\n(i.e. does not show a cursor), the "Return" and "Escape"\nkeys do the same as the "OK" and "Cancel" buttons,\nrespectively.

Changes to lang/pl.rc.

53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
*PasswdDlg.title:  Wpisz login i hasło


! --- symbolic names of label of SelectColor dialog ----------------------------

*baseColorsName: Kolory podstawowe
*userColorsName: Kolory niestandardowe


*yourSelectionName: Your Selection
*colorSelectorsName: Color Selectors
*hoverHelpName: Hover for help with color selection by:
*mouseHelpName: Mouse
*keyboardHelpName: Keyboard

! --- dynamic help text for SelectColor dialog.  Lines 75 chars max, split by '\n'.

*mouseHelpTextName: Click or drag the mouse in the Color Selectors to choose a color.\nIf the selected color remains black, regardless of what you\ndo in the left-hand Color Selector (for hue and saturation), check\nthe position of the pointer in the right-hand Color Selector\n(for brightness).\n\nClick one of the "Base colors" to read a value from this palette.\n\nClick one of the "User colors" to read a value from this palette,\nor to write to the palette if the color is blank.  If you then\nuse the Color Selectors to change the color, your choice will be\nwritten to this (User) palette color until you select another\n(Base or User) palette color.

*keyboardHelpTextName: Click in the text entry window in the left of the "Your\nSelection" area.\n\nType the color that you want in hexadecimal RGB format.\nWhenever the number of hexadecimal digits is a multiple\nof 3, the color value is valid and will be copied to the\nother parts of the Color Selector.\n\nLeave the text entry window by clicking anywhere else,\nor by pressing the "Escape" or "Return" key.  The text\nentry window will then display the color in 24-bit RGB\nformat, although internally the Color Selector uses\n48-bit colors.\n\nWhen the text entry widget does not have keyboard focus\n(i.e. does not show a cursor), the "Return" and "Escape"\nkeys do the same as the "OK" and "Cancel" buttons,\nrespectively.






<












53
54
55
56
57
58
59

60
61
62
63
64
65
66
67
68
69
70
71
*PasswdDlg.title:  Wpisz login i hasło


! --- symbolic names of label of SelectColor dialog ----------------------------

*baseColorsName: Kolory podstawowe
*userColorsName: Kolory niestandardowe


*yourSelectionName: Your Selection
*colorSelectorsName: Color Selectors
*hoverHelpName: Hover for help with color selection by:
*mouseHelpName: Mouse
*keyboardHelpName: Keyboard

! --- dynamic help text for SelectColor dialog.  Lines 75 chars max, split by '\n'.

*mouseHelpTextName: Click or drag the mouse in the Color Selectors to choose a color.\nIf the selected color remains black, regardless of what you\ndo in the left-hand Color Selector (for hue and saturation), check\nthe position of the pointer in the right-hand Color Selector\n(for brightness).\n\nClick one of the "Base colors" to read a value from this palette.\n\nClick one of the "User colors" to read a value from this palette,\nor to write to the palette if the color is blank.  If you then\nuse the Color Selectors to change the color, your choice will be\nwritten to this (User) palette color until you select another\n(Base or User) palette color.

*keyboardHelpTextName: Click in the text entry window in the left of the "Your\nSelection" area.\n\nType the color that you want in hexadecimal RGB format.\nWhenever the number of hexadecimal digits is a multiple\nof 3, the color value is valid and will be copied to the\nother parts of the Color Selector.\n\nLeave the text entry window by clicking anywhere else,\nor by pressing the "Escape" or "Return" key.  The text\nentry window will then display the color in 24-bit RGB\nformat, although internally the Color Selector uses\n48-bit colors.\n\nWhen the text entry widget does not have keyboard focus\n(i.e. does not show a cursor), the "Return" and "Escape"\nkeys do the same as the "OK" and "Cancel" buttons,\nrespectively.

Changes to listbox.tcl.

23
24
25
26
27
28
29

30
31
32
33
34
35
36
...
126
127
128
129
130
131
132

133
134
135
136
137
138
139
...
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
...
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
...
951
952
953
954
955
956
957














958
959
960
961
962
963
964
....
1042
1043
1044
1045
1046
1047
1048

1049
1050
1051
1052
1053
1054
1055
1056
....
1123
1124
1125
1126
1127
1128
1129









1130
1131
1132
1133
1134
1135
1136
....
1157
1158
1159
1160
1161
1162
1163



1164
1165

1166
1167
1168
1169
1170
1171
1172
#     - ListBox::see
#     - ListBox::edit
#     - ListBox::xview
#     - ListBox::yview
#     - ListBox::_update_edit_size
#     - ListBox::_destroy
#     - ListBox::_see

#     - ListBox::_update_scrollregion
#     - ListBox::_draw_item
#     - ListBox::_redraw_items
#     - ListBox::_redraw_selection
#     - ListBox::_redraw_listbox
#     - ListBox::_redraw_idle
#     - ListBox::_resize
................................................................................
    # For 8.4+ we don't want to inherit the padding
    catch {$path configure -padx 0 -pady 0}
    # widget informations
    set data(nrows) -1

    # items informations
    set data(items)    {}

    set data(selitems) {}

    # update informations
    set data(upd,level)   0
    set data(upd,afterid) ""
    set data(upd,level)   0
    set data(upd,delete)  {}
................................................................................
    set selectmodePrevious [Widget::getoption $path -selectmode]
    set res [Widget::configure $path $args]

    if { [Widget::hasChanged $path -selectmode selectmode] } {
        _configureSelectmode $path $selectmode $selectmodePrevious
    }

    set ch1 [expr {[Widget::hasChanged $path -deltay dy]  |

                   [Widget::hasChanged $path -padx val]   |
                   [Widget::hasChanged $path -multicolumn val]}]

    set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |
                   [Widget::hasChanged $path -selectforeground val]}]

    set redraw 0
    if { [Widget::hasChanged $path -height h] } {
        $path.c configure -height [expr {$h*$dy}]

        set redraw 1

    }
    if { [Widget::hasChanged $path -width w] } {
        $path.c configure -width [expr {$w*8}]
        set redraw 1
    }

    if { [Widget::hasChanged $path -background bg] } {
................................................................................

# ----------------------------------------------------------------------------
#  Command ListBox::see
# ----------------------------------------------------------------------------
proc ListBox::see { path item } {
    variable $path
    upvar 0  $path data







    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
        after cancel $data(upd,afterid)
        _redraw_listbox $path
    }
    set idn [$path.c find withtag n:$item]
    if { $idn != "" } {
        set idi [$path.c find withtag i:$item]
        if { $idi == "" } { set idi $idn }
        ListBox::_see $path $idn right
        ListBox::_see $path $idi left
    }

}


# ----------------------------------------------------------------------------
#  Command ListBox::edit
# ----------------------------------------------------------------------------
proc ListBox::edit { path item text {verifycmd ""} {clickres 0} {select 1}} {
................................................................................
        set x0  [expr {int([lindex $bbox 0]/$dx)}]
        if { $x0 < $xv0 } {
            $path.c xview scroll [expr {$x0-$xv0}] units
        }
    }
}
















# ----------------------------------------------------------------------------
#  Command ListBox::_update_scrollregion
# ----------------------------------------------------------------------------
proc ListBox::_update_scrollregion { path } {
    set bd   [$path.c cget -borderwidth]
    set ht   [$path.c cget -highlightthickness]
................................................................................
    set cursor [$path.c cget -cursor]
    $path.c configure -cursor watch
    update idletasks ; # make sure watch cursor is reflected
    set dx   [Widget::getoption $path -deltax]
    set dy   [Widget::getoption $path -deltay]
    set padx [Widget::getoption $path -padx]
    set y0   [expr {$dy/2}]

    set x0   4
    set x1   [expr {$x0+$padx}]
    set nitem 0
    set width 0
    set drawn {}
    set data(xlist) {}
    if { [Widget::cget $path -multicolumn] } {
        set nrows $data(nrows)
................................................................................
    if {$selfill && !$multi} {
	# cache window width for use below
	set width [winfo width $path]
    }
    foreach item $data(selitems) {
        set bbox [$path.c bbox "n:$item"]
        if { [llength $bbox] } {









	    if { $selfill && !$multi } {
		# With -selectfill, make box occupy full width of widget
		set bbox [list 0 [lindex $bbox 1] $width [lindex $bbox 3]]
	    }
            set tags [list sel s:$item click clickbind]
            set id [$path.c create rectangle $bbox \
                -fill $selbg -outline $selbg -tags $tags]
................................................................................
            _redraw_items $path
        }
        _redraw_selection $path
        _update_scrollregion $path
        if {[Widget::cget $path -selectfill]} {
            _update_select_fill $path
        }



        set data(upd,level)   0
        set data(upd,afterid) ""

    }
}


# ----------------------------------------------------------------------------
#  Command ListBox::_redraw_idle
# ----------------------------------------------------------------------------






>







 







>







 







|
>







|

>
|
>







 







>
>
>
>
>
>





<
<
<
<
<
<
|
>







 







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







 







>
|







 







>
>
>
>
>
>
>
>
>







 







>
>
>


>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
...
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
...
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
...
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
...
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
....
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
....
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
....
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
#     - ListBox::see
#     - ListBox::edit
#     - ListBox::xview
#     - ListBox::yview
#     - ListBox::_update_edit_size
#     - ListBox::_destroy
#     - ListBox::_see
#     - ListBox::_see_item
#     - ListBox::_update_scrollregion
#     - ListBox::_draw_item
#     - ListBox::_redraw_items
#     - ListBox::_redraw_selection
#     - ListBox::_redraw_listbox
#     - ListBox::_redraw_idle
#     - ListBox::_resize
................................................................................
    # For 8.4+ we don't want to inherit the padding
    catch {$path configure -padx 0 -pady 0}
    # widget informations
    set data(nrows) -1

    # items informations
    set data(items)    {}
    set data(seeitem)  {}
    set data(selitems) {}

    # update informations
    set data(upd,level)   0
    set data(upd,afterid) ""
    set data(upd,level)   0
    set data(upd,delete)  {}
................................................................................
    set selectmodePrevious [Widget::getoption $path -selectmode]
    set res [Widget::configure $path $args]

    if { [Widget::hasChanged $path -selectmode selectmode] } {
        _configureSelectmode $path $selectmode $selectmodePrevious
    }

    set ch0 [expr {[Widget::hasChanged $path -deltay dy]}]
    set ch1 [expr {$ch0  |
                   [Widget::hasChanged $path -padx val]   |
                   [Widget::hasChanged $path -multicolumn val]}]

    set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |
                   [Widget::hasChanged $path -selectforeground val]}]

    set redraw 0
    if { [Widget::hasChanged $path -height h] || $ch0 } {
        $path.c configure -height [expr {$h*$dy}]
        if {!$ch0} {
            set redraw 1
        }
    }
    if { [Widget::hasChanged $path -width w] } {
        $path.c configure -width [expr {$w*8}]
        set redraw 1
    }

    if { [Widget::hasChanged $path -background bg] } {
................................................................................

# ----------------------------------------------------------------------------
#  Command ListBox::see
# ----------------------------------------------------------------------------
proc ListBox::see { path item } {
    variable $path
    upvar 0  $path data

    if {$data(nrows) == -1} {
	# Not yet realized.
	set data(seeitem) $item
	return
    }

    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
        after cancel $data(upd,afterid)
        _redraw_listbox $path
    }







    _see_item $path $item;
}


# ----------------------------------------------------------------------------
#  Command ListBox::edit
# ----------------------------------------------------------------------------
proc ListBox::edit { path item text {verifycmd ""} {clickres 0} {select 1}} {
................................................................................
        set x0  [expr {int([lindex $bbox 0]/$dx)}]
        if { $x0 < $xv0 } {
            $path.c xview scroll [expr {$x0-$xv0}] units
        }
    }
}


# ----------------------------------------------------------------------------
#  Command ListBox::_see_item
# ----------------------------------------------------------------------------
proc ListBox::_see_item { path item } {
    set idn [$path.c find withtag n:$item]
    if { $idn != "" } {
        set idi [$path.c find withtag i:$item]
        if { $idi == "" } { set idi $idn }
        _see $path $idn right
        _see $path $idi left
    }
}


# ----------------------------------------------------------------------------
#  Command ListBox::_update_scrollregion
# ----------------------------------------------------------------------------
proc ListBox::_update_scrollregion { path } {
    set bd   [$path.c cget -borderwidth]
    set ht   [$path.c cget -highlightthickness]
................................................................................
    set cursor [$path.c cget -cursor]
    $path.c configure -cursor watch
    update idletasks ; # make sure watch cursor is reflected
    set dx   [Widget::getoption $path -deltax]
    set dy   [Widget::getoption $path -deltay]
    set padx [Widget::getoption $path -padx]
    set y0   [expr {$dy/2}]
    # Changed from 4 to 2 to make highlight work and look nice for listbox with image as well
    set x0   2
    set x1   [expr {$x0+$padx}]
    set nitem 0
    set width 0
    set drawn {}
    set data(xlist) {}
    if { [Widget::cget $path -multicolumn] } {
        set nrows $data(nrows)
................................................................................
    if {$selfill && !$multi} {
	# cache window width for use below
	set width [winfo width $path]
    }
    foreach item $data(selitems) {
        set bbox [$path.c bbox "n:$item"]
        if { [llength $bbox] } {
            set imgbox [$path.c bbox i:$item]
            lassign $bbox x0 y0 x1 y1;
            if {[string compare "" $imgbox]} {
                # image may exist and may be higher than text!
                lassign $imgbox ix0 iy0 ix1 iy1;
                set bbox [list $x0 [expr {$iy0<$y0?$iy0:$y0}] $x1 [expr {$iy1<$y1?$iy1:$y1}]];
            } else {
                set bbox [list $x0 [lindex $bbox 1] $x1 [lindex $bbox 3]]
            }
	    if { $selfill && !$multi } {
		# With -selectfill, make box occupy full width of widget
		set bbox [list 0 [lindex $bbox 1] $width [lindex $bbox 3]]
	    }
            set tags [list sel s:$item click clickbind]
            set id [$path.c create rectangle $bbox \
                -fill $selbg -outline $selbg -tags $tags]
................................................................................
            _redraw_items $path
        }
        _redraw_selection $path
        _update_scrollregion $path
        if {[Widget::cget $path -selectfill]} {
            _update_select_fill $path
        }
	if {![string equal $data(seeitem) ""]} {
	    _see_item $path $data(seeitem);
	}
        set data(upd,level)   0
        set data(upd,afterid) ""
	set data(seeitem) "";
    }
}


# ----------------------------------------------------------------------------
#  Command ListBox::_redraw_idle
# ----------------------------------------------------------------------------

Changes to mainframe.tcl.

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
...
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
...
200
201
202
203
204
205
206
207

208
209
210
211
212
213
214
...
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
...
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
...
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
...
621
622
623
624
625
626
627
628
629
630




631





632
633
634
635
636
637
638
...
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
	    rename {
	-maximum    -progressmax
	-variable   -progressvar
	-type       -progresstype
	-foreground -progressfg
    }



    Widget::declare MainFrame {
	{-width         TkResource 0      0 frame}
	{-height        TkResource 0      0 frame}















	{-background    TkResource ""     0 frame}
	{-textvariable  String     ""     0}
	{-casesensitive Boolean    0      0}
	{-menu          String     {}     1}
	{-separator     Enum       both   1 {none top bottom both}}
	{-bg            Synonym    -background}

	{-menubarfont   String     ""  0}
	{-menuentryfont String     ""  0}
	{-statusbarfont String     ""  0}
	{-sizegrip      Boolean    0   1}
    }

    Widget::addmap MainFrame "" .frame  {-width {} -height {} -background {}}
    Widget::addmap MainFrame "" .topf   {-background {}}
    Widget::addmap MainFrame "" .botf   {-background {}}
    Widget::addmap MainFrame "" .status {-background {}}
    Widget::addmap MainFrame "" .status.label {-background {}}
    Widget::addmap MainFrame "" .status.indf  {-background {}}
    Widget::addmap MainFrame "" .status.prgf  {-background {}}
    Widget::addmap MainFrame ProgressBar .status.prg {-background {} -background -troughcolor}


    variable _widget
}


# ----------------------------------------------------------------------------
#  Command MainFrame::create
................................................................................

    set _widget($path,top)      $top
    set _widget($path,ntoolbar) 0
    set _widget($path,nindic)   0

    set menu [Widget::getoption $path -menu]
    if { [llength $menu] } {
        _create_menubar $path $menu [Widget::getoption $path -casesensitive]
    }

    bind $path <Destroy> [list MainFrame::_destroy %W]

    return [Widget::create MainFrame $path]
}

................................................................................

    if { [Widget::hasChanged $path -textvariable newv] } {
        uplevel \#0 $path.status.label configure -textvariable [list $newv]
    }

    # The ttk frame has no -background
    if {![Widget::theme] && [Widget::hasChanged $path -background bg] } {
	if {$::tcl_platform(platform) == "unix"} {

	    set listmenu [$_widget($path,top) cget -menu]
	    while { [llength $listmenu] } {
		set newlist {}
		foreach menu $listmenu {
		    $menu configure -background $bg
		    set newlist [concat $newlist [winfo children $menu]]
		}
................................................................................
    }
}


# ----------------------------------------------------------------------------
#  Command MainFrame::_create_menubar
# ----------------------------------------------------------------------------
proc MainFrame::_create_menubar { path descmenu casesensitive } {
    variable _widget
    global    tcl_platform

    set top $_widget($path,top)

    foreach {v x} {mbfnt -menubarfont mefnt -menuentryfont} {
	if {[string length [Widget::getoption $path $x]]} {
................................................................................
	# [email protected]:  Add mapping from menu items to tags
	set _widget($path,menutags,[list $menubar $count]) $tags

        if { [string length $menuid] } {
            # menu has identifier
            set _widget($path,menuid,$menuid) $menu
        }
        _create_entries $path $menu $menuopts $entries $casesensitive
        incr count
    }
}


# ----------------------------------------------------------------------------
#  Command MainFrame::_create_entries
# ----------------------------------------------------------------------------
proc MainFrame::_create_entries { path menu menuopts entries casesensitive } {
    variable _widget

    set count      [$menu cget -tearoff]
    set registered 0
    foreach entry $entries {
        set len  [llength $entry]
        set type [lindex $entry 0]
................................................................................
            set submenu $menu.menu$count
            eval [list $menu add cascade] $opt [list -menu $submenu]
            eval [list menu $submenu -tearoff $tearoff] $menuopts
            if { [string length $menuid] } {
                # menu has identifier
                set _widget($path,menuid,$menuid) $submenu
            }
            _create_entries $path $submenu $menuopts [lindex $entry 5] $casesensitive
            incr count
            continue
        }

        # entry help description
        set desc [lindex $entry 3]
        if { [string length $desc] } {
................................................................................
                DynamicHelp::register $menu menu [Widget::getoption $path -textvariable]
                set registered 1
            }
            DynamicHelp::register $menu menuentry $count $desc
        }

        # entry accelerator
        set accel [_parse_accelerator [lindex $entry 4] $casesensitive]
        if { [llength $accel] } {
            lappend opt -accelerator [lindex $accel 0]




            bind $_widget($path,top) [lindex $accel 1] [list $menu invoke $count]





        }

        # user options
        set useropt [lrange $entry 5 end]
        if { [string equal $type "command"] ||
             [string equal $type "radiobutton"] ||
             [string equal $type "checkbutton"] } {
................................................................................
    }
}


# MainFrame::_parse_accelerator --
#
#	Given a key combo description, construct an appropriate human readable
#	string (for display on as a menu accelerator) and the corresponding
#	bind event.

#







# Arguments:
#	desc		a list with the following format:
#				?sequence? key
#			sequence may be None, Ctrl, Alt, or CtrlAlt

#			key may be any key
#	casesensitive	Boolean if accelerator is case sensitive
#
# Results:
#	{accel event}	a list containing the accelerator string and the event


proc MainFrame::_parse_accelerator { desc casesensitive} {



    if { [llength $desc] == 1 } {
	set seq None
	set key [lindex $desc 0]
	# If the key is an F key (ie, F1, F2, etc), it has to be capitalized
	if {[regexp {^f([1-9]|([12][0-9]|3[0-5]))$} [string tolower $key]]} {
	    set key [string toupper $key]

	}
    } elseif { [llength $desc] == 2 } {
        set seq [lindex $desc 0]
        set key [lindex $desc 1]
	# If the key is an F key (ie, F1, F2, etc), it has to be capitalized
	if {[regexp {^f([1-9]|([12][0-9]|3[0-5]))$} [string tolower $key]]} {
	    set key [string toupper $key]

	}
    } else {
	return {}
    }
    if {! $casesensitive} {







 	set akey [string toupper $key]
 	set ekey [string tolower $key]
    } else {
	set akey $key
	set ekey $key
    }
    switch -- $seq {
	None {
	    set accel $akey
	    set event "<Key-$ekey>"



	}



















































	Ctrl {
	    set accel "Ctrl+$akey"
	    set event "<Control-Key-$ekey>"
	}
	Alt {
	    set accel "Alt+$akey"
	    set event "<Alt-Key-$ekey>"
	}
	CtrlAlt {
	    set accel "Ctrl+Alt+$akey"
	    set event "<Control-Alt-Key-$ekey>"
	}
	default {
	    return -code error "invalid accelerator code $seq"
	}
    }

    return [list $accel $event]
}






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

|
|
|
|
|

|
|
|
|
|
|
|
|
>







 







|







 







|
>







 







|







 







|








|







 







|







 







|


>
>
>
>
|
>
>
>
>
>







 







|
|
>

>
>
>
>
>
>
>

|
|
|
>
|
<


|
>

|
>
>
>


|

|

>



|

|

>




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


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

|
|


|
|


|
|





>
|

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
...
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
...
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
...
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
...
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
...
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
...
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
...
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
	    rename {
	-maximum    -progressmax
	-variable   -progressvar
	-type       -progresstype
	-foreground -progressfg
    }

    if {[Widget::theme]} {
        # No option -background for themed MainFrame
        Widget::declare MainFrame {
            {-width         TkResource 0      0 frame}
            {-height        TkResource 0      0 frame}
            {-textvariable  String     ""     0}
            {-menu          String     {}     1}
            {-separator     Enum       both   1 {none top bottom both}}

            {-menubarfont   String     ""  0}
            {-menuentryfont String     ""  0}
            {-statusbarfont String     ""  0}
            {-sizegrip      Boolean    0   1}
        }

        Widget::addmap MainFrame "" .frame  {-width {} -height {}}
    } else {
        Widget::declare MainFrame {
            {-width         TkResource 0      0 frame}
            {-height        TkResource 0      0 frame}
            {-background    TkResource ""     0 frame}
            {-textvariable  String     ""     0}

            {-menu          String     {}     1}
            {-separator     Enum       both   1 {none top bottom both}}
            {-bg            Synonym    -background}

            {-menubarfont   String     ""  0}
            {-menuentryfont String     ""  0}
            {-statusbarfont String     ""  0}
            {-sizegrip      Boolean    0   1}
        }

        Widget::addmap MainFrame "" .frame  {-width {} -height {} -background {}}
        Widget::addmap MainFrame "" .topf   {-background {}}
        Widget::addmap MainFrame "" .botf   {-background {}}
        Widget::addmap MainFrame "" .status {-background {}}
        Widget::addmap MainFrame "" .status.label {-background {}}
        Widget::addmap MainFrame "" .status.indf  {-background {}}
        Widget::addmap MainFrame "" .status.prgf  {-background {}}
        Widget::addmap MainFrame ProgressBar .status.prg {-background {} -background -troughcolor}
    }

    variable _widget
}


# ----------------------------------------------------------------------------
#  Command MainFrame::create
................................................................................

    set _widget($path,top)      $top
    set _widget($path,ntoolbar) 0
    set _widget($path,nindic)   0

    set menu [Widget::getoption $path -menu]
    if { [llength $menu] } {
        _create_menubar $path $menu
    }

    bind $path <Destroy> [list MainFrame::_destroy %W]

    return [Widget::create MainFrame $path]
}

................................................................................

    if { [Widget::hasChanged $path -textvariable newv] } {
        uplevel \#0 $path.status.label configure -textvariable [list $newv]
    }

    # The ttk frame has no -background
    if {![Widget::theme] && [Widget::hasChanged $path -background bg] } {
	if {($::tcl_platform(platform) == "unix")
	        && (0 != [string compare [tk windowingsystem] "aqua"])} {
	    set listmenu [$_widget($path,top) cget -menu]
	    while { [llength $listmenu] } {
		set newlist {}
		foreach menu $listmenu {
		    $menu configure -background $bg
		    set newlist [concat $newlist [winfo children $menu]]
		}
................................................................................
    }
}


# ----------------------------------------------------------------------------
#  Command MainFrame::_create_menubar
# ----------------------------------------------------------------------------
proc MainFrame::_create_menubar { path descmenu } {
    variable _widget
    global    tcl_platform

    set top $_widget($path,top)

    foreach {v x} {mbfnt -menubarfont mefnt -menuentryfont} {
	if {[string length [Widget::getoption $path $x]]} {
................................................................................
	# [email protected]:  Add mapping from menu items to tags
	set _widget($path,menutags,[list $menubar $count]) $tags

        if { [string length $menuid] } {
            # menu has identifier
            set _widget($path,menuid,$menuid) $menu
        }
        _create_entries $path $menu $menuopts $entries
        incr count
    }
}


# ----------------------------------------------------------------------------
#  Command MainFrame::_create_entries
# ----------------------------------------------------------------------------
proc MainFrame::_create_entries { path menu menuopts entries } {
    variable _widget

    set count      [$menu cget -tearoff]
    set registered 0
    foreach entry $entries {
        set len  [llength $entry]
        set type [lindex $entry 0]
................................................................................
            set submenu $menu.menu$count
            eval [list $menu add cascade] $opt [list -menu $submenu]
            eval [list menu $submenu -tearoff $tearoff] $menuopts
            if { [string length $menuid] } {
                # menu has identifier
                set _widget($path,menuid,$menuid) $submenu
            }
            _create_entries $path $submenu $menuopts [lindex $entry 5]
            incr count
            continue
        }

        # entry help description
        set desc [lindex $entry 3]
        if { [string length $desc] } {
................................................................................
                DynamicHelp::register $menu menu [Widget::getoption $path -textvariable]
                set registered 1
            }
            DynamicHelp::register $menu menuentry $count $desc
        }

        # entry accelerator
        set accel [_parse_accelerator [lindex $entry 4]]
        if { [llength $accel] } {
            lappend opt -accelerator [lindex $accel 0]
            foreach event [lindex $accel 1] {
                bind $_widget($path,top) $event [list $menu invoke $count]
            }
            foreach event [lindex $accel 2] {
                if {[bind $_widget($path,top) $event] == {}} {
                    bind $_widget($path,top) $event { # do nothing }
                } else {
                    # The existing binding will intercept these events.
                }
            }
        }

        # user options
        set useropt [lrange $entry 5 end]
        if { [string equal $type "command"] ||
             [string equal $type "radiobutton"] ||
             [string equal $type "checkbutton"] } {
................................................................................
    }
}


# MainFrame::_parse_accelerator --
#
#	Given a key combo description, construct an appropriate human readable
#	string (for display on as a menu accelerator), a list of the
#	corresponding bind events, and a separate list of bind events that need
#	to be blocked.
#
# 	When argument $desc does not include "Shift", the bindings to $events
# 	will in some cases also intercept events that have the modifier "Shift",
# 	unless more specific bindings $blockEvents exist to the latter.  This
# 	situation occurs, for example, when a Cmd binding exists without a
# 	corresponding ShiftCmd binding.  The list of events that need to be
#       blocked is returned as the third element of the result.
#
# Arguments:
#	desc	a list with the following format:
#			?sequence? key
#		sequence may be None, Ctrl, Alt, CtrlAlt, Shift, Cmd or
#			ShiftCmd
#		key may be any key

#
# Results:
#	{accel events blockEvents}  a list containing the accelerator string and
#	                            two lists of events

proc MainFrame::_parse_accelerator { desc } {
    variable _widget

    set fKey 0
    if { [llength $desc] == 1 } {
	set seq None
	set key [string tolower [lindex $desc 0]]
	# If the key is an F key (ie, F1, F2, etc), it has to be capitalized
	if {[regexp {^f([1-9]|([12][0-9]|3[0-5]))$} $key]} {
	    set key [string toupper $key]
	    set fKey 1
	}
    } elseif { [llength $desc] == 2 } {
        set seq [lindex $desc 0]
        set key [string tolower [lindex $desc 1]]
	# If the key is an F key (ie, F1, F2, etc), it has to be capitalized
	if {[regexp {^f([1-9]|([12][0-9]|3[0-5]))$} $key]} {
	    set key [string toupper $key]
	    set fKey 1
	}
    } else {
	return {}
    }


    # Plain "Shift" can be used only with F keys, but "ShiftCmd" is allowed.
    if {[string equal $seq "Shift"] && (!$fKey)} {
        return -code error {Shift accelerator can be used only with F keys}
    }

    set blockEvents {}
    set upc [string toupper $key]





    switch -- $seq {
	None {
	    set accel "$upc"

	    set events [list "<Key-$key>"]
	    if {$fKey} {
		set blockEvents [list "<Shift-Key-$key>"]
	    }
	}
	Shift {
	    # Used only with Function keys.
	    set accel "Shift+$upc"
	    set events [list "<Shift-Key-$key>"]
	}
	Cmd {
	    set accel "Cmd+$upc"

	    if {    [string equal [tk windowingsystem] "aqua"] &&
		   ([string first AppKit [winfo server .]] == -1)
	    } {
		# Carbon
	        set events [list "<Command-Key-$key>" \
	                    "<Lock-Command-Key-$upc>" ]
		set blockEvents [list "<Lock-Shift-Command-Key-$upc>"]
		# Both bindings must be included in $events -  the first binding
		# does not fire if "Lock" is set, and this is as bind(n) states
		# because the second binding is NOT a more specialized form of
		# the first.
	    } else {
		# Cocoa and anything else that uses Cmd
	        set events [list "<Command-Key-$key>"]
	        # A binding to "<Lock-Command-Key-$upc>" must not be included
	        # here - both events fire if "Lock" is set.
		set blockEvents [list "<Shift-Command-Key-$key>"]
	    }
	}
	ShiftCmd {
	    if {    [string equal [tk windowingsystem] "aqua"] &&
		    ([string first AppKit [winfo server .]] == -1)
	    } {
		# Carbon
		set accel "Shift+Cmd+$upc"
		set events [list "<Shift-Command-Key-$upc>" \
			    "<Lock-Shift-Command-Key-$upc>"]
		# Both bindings must be included here -  the first binding does
		# not fire if "Lock" is set, even though the second binding
		# should be recognized as a more specialized form of the first.
	    } else {
		# Cocoa and anything else that uses Cmd
		set accel "Shift+Cmd+$upc"
		set events [list "<Shift-Command-Key-$key>"]
		# A binding to "<Lock-Shift-Command-Key-$key>" must not be
		# included here - both events fire if "Lock" is set.
		# Tk/Cocoa fails to recognize
		# <Lock-Shift-Command-Key-$key> as a "more specialized" binding
		# than <Shift-Command-Key-$key>.
		# Perversely, Tk/Carbon (above) makes the opposite error.
	    }
	}
	Ctrl {
	    set accel "Ctrl+$upc"
	    set events [list "<Control-Key-$key>"]
	}
	Alt {
	    set accel "Alt+$upc"
	    set events [list "<Alt-Key-$key>"]
	}
	CtrlAlt {
	    set accel "Ctrl+Alt+$upc"
	    set events [list "<Control-Alt-Key-$key>"]
	}
	default {
	    return -code error "invalid accelerator code $seq"
	}
    }

    return [list $accel $events $blockEvents]
}

Changes to notebook.tcl.

1103
1104
1105
1106
1107
1108
1109






1110

1111
1112



1113

1114
1115
1116
1117
1118
1119
1120
1121
1122
# -----------------------------------------------------------------------------
#  Command NoteBook::_resize
# -----------------------------------------------------------------------------
proc NoteBook::_resize { path } {
    variable $path
    upvar 0  $path data







    if {!$data(realized)} {

	if { [set width  [Widget::cget $path -width]]  == 0 ||
	     [set height [Widget::cget $path -height]] == 0 } {



	    compute_size $path

	}
	set data(realized) 1
    }

    NoteBook::_redraw $path
}


# Tree::_set_help --






>
>
>
>
>
>

>
|
|
>
>
>

>

<







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
# -----------------------------------------------------------------------------
#  Command NoteBook::_resize
# -----------------------------------------------------------------------------
proc NoteBook::_resize { path } {
    variable $path
    upvar 0  $path data

    # Check if pages are fully initialized or if we are still initializing
    if { 0 < [llength $data(pages)] &&
	 ![info exists data([lindex $data(pages) end],width)] } {
	return
    }
    
    if {!$data(realized)} {
	set data(realized) 1
	if { [Widget::cget $path -width]  == 0 ||
	     [Widget::cget $path -height] == 0 } {
	    # This does an update allowing other events (resize) to enter
	    # In addition, it does a redraw, so first set the realized and
	    # then exit
	    compute_size $path
	    return
	}

    }

    NoteBook::_redraw $path
}


# Tree::_set_help --

Changes to pkgIndex.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
29
30
31
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
if {[catch {package require Tcl}]} return


package ifneeded BWidget 1.9.6 "\
    package require Tk 8.1.1;\
    [list tclPkgSetup $dir BWidget 1.9.6 {
{arrow.tcl source {ArrowButton ArrowButton::create ArrowButton::use}}
{labelframe.tcl source {LabelFrame LabelFrame::create LabelFrame::use}}
{labelentry.tcl source {LabelEntry LabelEntry::create LabelEntry::use}}
{bitmap.tcl source {Bitmap::get Bitmap::use}}
{button.tcl source {Button Button::create Button::use}}
{buttonbox.tcl source {ButtonBox ButtonBox::create ButtonBox::use}}
{combobox.tcl source {ComboBox ComboBox::create ComboBox::use}}
{label.tcl source {Label Label::create Label::use}}
{entry.tcl source {Entry Entry::create Entry::use}}
{pagesmgr.tcl source {PagesManager PagesManager::create PagesManager::use}}
{notebook.tcl source {NoteBook NoteBook::create NoteBook::use}}
{panedw.tcl source {PanedWindow PanedWindow::create PanedWindow::use}}
{scrollw.tcl source {ScrolledWindow ScrolledWindow::create ScrolledWindow::use}}
{scrollview.tcl source {ScrollView ScrollView::create ScrollView::use}}


{scrollframe.tcl source {ScrollableFrame ScrollableFrame::create ScrollableFrame::use}}
{panelframe.tcl source {PanelFrame PanelFrame::create PanelFrame::use}}

{progressbar.tcl source {ProgressBar ProgressBar::create ProgressBar::use}}
{progressdlg.tcl source {ProgressDlg ProgressDlg::create ProgressDlg::use}}
{passwddlg.tcl source {PasswdDlg PasswdDlg::create PasswdDlg::use}}
{dragsite.tcl source {DragSite::register DragSite::include DragSite::use}}
{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}}
{statusbar.tcl source {StatusBar StatusBar::create StatusBar::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 SelectColor::setcolor SelectColor::setbasecolor}}
{dynhelp.tcl source {DynamicHelp::configure DynamicHelp::use DynamicHelp::register DynamicHelp::include DynamicHelp::add DynamicHelp::delete}}
{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}}
{wizard.tcl source {Wizard Wizard::create Wizard::use SimpleWizard ClassicWizard}}

{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]]; \
"
>
>
|

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




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
if {[catch {package require Tcl}]} return
# NOTE: auto_loaded top-level commands shall not be qualified (no leading ::)
# but all others should.  See auto_qualify for details.
package ifneeded BWidget 1.9.11 "\
    package require Tk 8.1.1;\
    [list tclPkgSetup $dir BWidget 1.9.11 {


	{arrow.tcl       source {ArrowButton ::ArrowButton::create ::ArrowButton::use}}
	{labelframe.tcl  source {LabelFrame ::LabelFrame::create ::LabelFrame::use}}
	{labelentry.tcl  source {LabelEntry ::LabelEntry::create ::LabelEntry::use}}
	{bitmap.tcl      source {::Bitmap::get ::Bitmap::use}}
	{button.tcl      source {Button ::Button::create ::Button::use}}
	{buttonbox.tcl   source {ButtonBox ::ButtonBox::create ::ButtonBox::use}}
	{combobox.tcl    source {ComboBox ::ComboBox::create ::ComboBox::use}}
	{label.tcl       source {Label ::Label::create ::Label::use}}
	{entry.tcl       source {Entry ::Entry::create ::Entry::use}}
	{pagesmgr.tcl    source {PagesManager ::PagesManager::create ::PagesManager::use}}
	{notebook.tcl    source {NoteBook ::NoteBook::create ::NoteBook::use}}
	{panedw.tcl      source {PanedWindow ::PanedWindow::create ::PanedWindow::use}}
	{scrollw.tcl     source {ScrolledWindow ::ScrolledWindow::create ::ScrolledWindow::use}}
	{scrollview.tcl  source {ScrollView ::ScrollView::create ::ScrollView::use}}
	{scrollframe.tcl source {ScrollableFrame ::ScrollableFrame::create ::ScrollableFrame::use}}

	{panelframe.tcl  source {PanelFrame ::PanelFrame::create ::PanelFrame::use}}
	{progressbar.tcl source {ProgressBar ::ProgressBar::create ::ProgressBar::use}}
	{progressdlg.tcl source {ProgressDlg ::ProgressDlg::create ::ProgressDlg::use}}


	{passwddlg.tcl   source {PasswdDlg ::PasswdDlg::create ::PasswdDlg::use}}
	{dragsite.tcl    source {::DragSite::register ::DragSite::include ::DragSite::use}}
	{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}}
	{statusbar.tcl   source {StatusBar ::StatusBar::create ::StatusBar::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 ::SelectColor::setcolor ::SelectColor::setbasecolor}}
	{dynhelp.tcl     source {::DynamicHelp::configure ::DynamicHelp::use ::DynamicHelp::register ::DynamicHelp::include ::DynamicHelp::add ::DynamicHelp::delete}}
	{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}}
	{wizard.tcl      source {Wizard ::Wizard::create ::Wizard::use SimpleWizard ClassicWizard}}
	{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 scrollframe.tcl.

93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
...
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
...
242
243
244
245
246
247
248
249
250
251
252
253
254

255
256
257
258
259
260
261
262
    bind $frame <Configure> \
        [list ScrollableFrame::_frameConfigure $canvas]
    # add <unmap> binding: <configure> is not called when frame
    # becomes so small that it suddenly falls outside of currently visible area.
    # but now we need to add a <map> binding too
    bind $frame <Map> \
        [list ScrollableFrame::_frameConfigure $canvas]
    bind $frame <Unmap> \
        [list ScrollableFrame::_frameConfigure $canvas 1]

    bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all]

    return [Widget::create ScrollableFrame $path]
}


................................................................................
proc ScrollableFrame::configure { path args } {
    set res [Widget::configure $path $args]
    set upd 0

    set modcw [Widget::hasChanged $path -constrainedwidth cw]
    set modw  [Widget::hasChanged $path -areawidth w]
    if { $modcw || (!$cw && $modw) } {


        if { $cw } {
            set w [winfo width $path]
        }
        set upd 1
    }

    set modch [Widget::hasChanged $path -constrainedheight ch]
    set modh  [Widget::hasChanged $path -areaheight h]
    if { $modch || (!$ch && $modh) } {


        if { $ch } {
            set h [winfo height $path]
        }
        set upd 1
    }

    if { $upd } {
        $path:cmd itemconfigure win -width $w -height $h
    }
    return $res
}

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


# ----------------------------------------------------------------------------
#  Command ScrollableFrame::_frameConfigure
# ----------------------------------------------------------------------------
proc ScrollableFrame::_max {a b} {return [expr {$a <= $b ? $b : $a}]}
proc ScrollableFrame::_frameConfigure {canvas {unmap 0}} {
    # This ensures that we don't get funny scrollability in the frame
    # when it is smaller than the canvas space
    # use [winfo] to get height & width of frame

    # [winfo] doesn't work for unmapped frame

    set frameh [expr {$unmap ? 0 : [winfo height $canvas.frame]}]
    set framew [expr {$unmap ? 0 : [winfo width  $canvas.frame]}]

    set height [_max $frameh [winfo height $canvas]]
    set width  [_max $framew [winfo width  $canvas]]

    $canvas:cmd configure -scrollregion [list 0 0 $width $height]
}






<
<







 







>
>
|
|
|
<
<




>
>
|
|
|
<
<







 







|



<
<
>
|
|
<
<
<



93
94
95
96
97
98
99


100
101
102
103
104
105
106
...
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
...
240
241
242
243
244
245
246
247
248
249
250


251
252
253



254
255
256
    bind $frame <Configure> \
        [list ScrollableFrame::_frameConfigure $canvas]
    # add <unmap> binding: <configure> is not called when frame
    # becomes so small that it suddenly falls outside of currently visible area.
    # but now we need to add a <map> binding too
    bind $frame <Map> \
        [list ScrollableFrame::_frameConfigure $canvas]



    bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all]

    return [Widget::create ScrollableFrame $path]
}


................................................................................
proc ScrollableFrame::configure { path args } {
    set res [Widget::configure $path $args]
    set upd 0

    set modcw [Widget::hasChanged $path -constrainedwidth cw]
    set modw  [Widget::hasChanged $path -areawidth w]
    if { $modcw || (!$cw && $modw) } {
        set upd 1
    }
    if { $cw } {
        set w [winfo width $path]
    }



    set modch [Widget::hasChanged $path -constrainedheight ch]
    set modh  [Widget::hasChanged $path -areaheight h]
    if { $modch || (!$ch && $modh) } {
        set upd 1
    }
    if { $ch } {
        set h [winfo height $path]
    }



    if { $upd } {
        $path:cmd itemconfigure win -width $w -height $h
    }
    return $res
}

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


# ----------------------------------------------------------------------------
#  Command ScrollableFrame::_frameConfigure
# ----------------------------------------------------------------------------
proc ScrollableFrame::_max {a b} {return [expr {$a <= $b ? $b : $a}]}
proc ScrollableFrame::_frameConfigure {canvas} {
    # This ensures that we don't get funny scrollability in the frame
    # when it is smaller than the canvas space
    # use [winfo] to get height & width of frame


    if {![winfo ismapped $canvas.frame]} { return }
    set height [_max [winfo height $canvas.frame] [winfo height $canvas]]
    set width  [_max [winfo width  $canvas.frame] [winfo width  $canvas]]




    $canvas:cmd configure -scrollregion [list 0 0 $width $height]
}

Changes to scrollw.tcl.

134
135
136
137
138
139
140

141
142
143
144
145
146
147
    if {[info exists data(widget)] && [winfo exists $data(widget)]
	&& ![string equal $data(widget) $widget]} {
	grid remove $data(widget)
	$data(widget) configure -xscrollcommand "" -yscrollcommand ""
    }
    set data(widget) $widget
    grid $widget -in $path -row 1 -column 1 -sticky news


    $path.hscroll configure -command [list $widget xview]
    $path.vscroll configure -command [list $widget yview]
    $widget configure \
	    -xscrollcommand [list ScrolledWindow::_set_hscroll $path] \
	    -yscrollcommand [list ScrolledWindow::_set_vscroll $path]
}






>







134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
    if {[info exists data(widget)] && [winfo exists $data(widget)]
	&& ![string equal $data(widget) $widget]} {
	grid remove $data(widget)
	$data(widget) configure -xscrollcommand "" -yscrollcommand ""
    }
    set data(widget) $widget
    grid $widget -in $path -row 1 -column 1 -sticky news
    raise $widget;

    $path.hscroll configure -command [list $widget xview]
    $path.vscroll configure -command [list $widget yview]
    $widget configure \
	    -xscrollcommand [list ScrolledWindow::_set_hscroll $path] \
	    -yscrollcommand [list ScrolledWindow::_set_vscroll $path]
}

Changes to tests/entry.test.

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
..
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
	    {unknown color name "non-existent"}}
    {-bd 4 4 bad Value {bad screen distance "badValue"}}
    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-command foo foo {} {}}
    {-disabledforeground blue blue non-existent \
	    {unknown color name "non-existent"}}
    {-editable false false shazbot {expected boolean value but got "shazbot"}}
    {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
    {-font {Helvetica 12 italic} {Helvetica 12 italic} {} \
	    {font "" doesn't exist}}
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
    {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}}
    {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
................................................................................
    } [list [lindex $test 2] [lindex $test 2]]
    incr i
}
destroy .e

test Entry-2.1 {Entry} {
    list [catch {Entry} msg] $msg
} {1 {no value given for parameter "path" to "Entry"}}
test Entry-2.2 {Entry} {
    list [catch {Entry gorp} msg] $msg
} {1 {bad window path name "gorp"}}
test Entry-2.3 {Entry procedure} {
    Entry .e
    set res [list [winfo exists .e] [winfo class .e] [info commands .e]]
    destroy .e






|







 







|







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
..
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
	    {unknown color name "non-existent"}}
    {-bd 4 4 bad Value {bad screen distance "badValue"}}
    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-command foo foo {} {}}
    {-disabledforeground blue blue non-existent \
	    {unknown color name "non-existent"}}
    {-editable false 0 shazbot {expected boolean value but got "shazbot"}}
    {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
    {-font {Helvetica 12 italic} {Helvetica 12 italic} {} \
	    {font "" doesn't exist}}
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
    {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}}
    {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
................................................................................
    } [list [lindex $test 2] [lindex $test 2]]
    incr i
}
destroy .e

test Entry-2.1 {Entry} {
    list [catch {Entry} msg] $msg
} {1 {wrong # args: should be "Entry path ..."}}
test Entry-2.2 {Entry} {
    list [catch {Entry gorp} msg] $msg
} {1 {bad window path name "gorp"}}
test Entry-2.3 {Entry procedure} {
    Entry .e
    set res [list [winfo exists .e] [winfo class .e] [info commands .e]]
    destroy .e

Changes to tree.tcl.

89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
        {-selectbackground TkResource "" 0 listbox}
        {-selectforeground TkResource "" 0 listbox}
	{-selectcommand    String     "" 0}
        {-width            TkResource "" 0 listbox}
        {-height           TkResource "" 0 listbox}
        {-selectfill       Boolean 0  0}
        {-showlines        Boolean 1  0}
        {-linesfill        TkResource black  0 {listbox -foreground}}
        {-linestipple      TkResource ""     0 {label -bitmap}}
	{-crossfill        TkResource black  0 {listbox -foreground}}
        {-redraw           Boolean 1  0}
        {-opencmd          String  "" 0}
        {-closecmd         String  "" 0}
        {-dropovermode     Flag    "wpn" 0 "wpn"}
        {-bg               Synonym -background}

        {-crossopenimage    String  ""  0}






|

|







89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
        {-selectbackground TkResource "" 0 listbox}
        {-selectforeground TkResource "" 0 listbox}
	{-selectcommand    String     "" 0}
        {-width            TkResource "" 0 listbox}
        {-height           TkResource "" 0 listbox}
        {-selectfill       Boolean 0  0}
        {-showlines        Boolean 1  0}
        {-linesfill        TkResource ""  0 {listbox -foreground}}
        {-linestipple      TkResource ""     0 {label -bitmap}}
	{-crossfill        TkResource ""  0 {listbox -foreground}}
        {-redraw           Boolean 1  0}
        {-opencmd          String  "" 0}
        {-closecmd         String  "" 0}
        {-dropovermode     Flag    "wpn" 0 "wpn"}
        {-bg               Synonym -background}

        {-crossopenimage    String  ""  0}

Changes to utils.tcl.

322
323
324
325
326
327
328

329



















330









331
332
333
334
335
336
337
            if { $idx == 1 } {
                if { $arglen == 2 } {
                    # center to widget
                    set x0 [expr {[winfo rootx $widget] + ([winfo width  $widget] - $w)/2}]
                    set y0 [expr {[winfo rooty $widget] + ([winfo height $widget] - $h)/2}]
                } else {
                    # center to screen

                    set x0 [expr {($sw - $w)/2 - [winfo vrootx $path]}]



















                    set y0 [expr {($sh - $h)/2 - [winfo vrooty $path]}]









                }
                set x "+$x0"
                set y "+$y0"
                if {$::tcl_platform(platform) != "windows"} {
                    if { $x0+$w > $sw } {set x "-0"; set x0 [expr {$sw-$w}]}
                    if { $x0 < 0 }      {set x "+0"}
                    if { $y0+$h > $sh } {set y "-0"; set y0 [expr {$sh-$h}]}






>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>







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
            if { $idx == 1 } {
                if { $arglen == 2 } {
                    # center to widget
                    set x0 [expr {[winfo rootx $widget] + ([winfo width  $widget] - $w)/2}]
                    set y0 [expr {[winfo rooty $widget] + ([winfo height $widget] - $h)/2}]
                } else {
                    # center to screen
                    set x [winfo rootx $path]
                    set x0 [expr {($sw - $w)/2}]
                    set vx [winfo vrootx $path]
                    set vw [winfo vrootwidth $path]
                    if {$x < 0 && $vx < 0} {
                        # We are left to the main screen
                        # Start of left screen: vx (negative)
                        # End coordinate of left screen: -1
                        # Width of left screen: vx * -1
                        # x0 = vx + ( -vx - w ) / 2
                        set x0 [expr {($vx - $w)/2}]
                    } elseif {$x > $sw && $vx+$vw > $sw} {
                        # We are right to the main screen
                        # Start of right screen: sw
                        # End of right screen: vx+vw-1
                        # Width of right screen: vx+vw-sw
                        # x0 = sw + ( vx + vw - sw - w ) / 2
                        set x0 [expr {($vx+$vw+$sw-$w)/2}]
                    }
                    # Same for y
                    set y [winfo rooty $path]
                    set y0 [expr {($sh - $h)/2}]
                    set vy [winfo vrooty $path]
                    set vh [winfo vrootheight $path]
                    if {$y < 0 && $vy < 0} {
                        # We are above to the main screen
                        set y0 [expr {($vy - $h)/2}]
                    } elseif {$y > $sh && $vy+$vh > $sh} {
                        # We are below to the main screen
                        set x0 [expr {($vy+$vh-$sh-$h)/2+$sh}]
                    }
                }
                set x "+$x0"
                set y "+$y0"
                if {$::tcl_platform(platform) != "windows"} {
                    if { $x0+$w > $sw } {set x "-0"; set x0 [expr {$sw-$w}]}
                    if { $x0 < 0 }      {set x "+0"}
                    if { $y0+$h > $sh } {set y "-0"; set y0 [expr {$sh-$h}]}

Changes to widget.tcl.

133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
...
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
...
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
...
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
...
768
769
770
771
772
773
774
775






776

777
778
779
780
781
782
783
...
825
826
827
828
829
830
831

832
833
834
835
836
837
838
839
840
....
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
....
1526
1527
1528
1529
1530
1531
1532

1533
1534

1535
1536
1537
1538
1539
1540
1541
....
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
    namespace eval $class {}
    upvar 0 ${class}::opt classopt
    upvar 0 ${class}::map classmap
    upvar 0 ${class}::map$subpath submap
    upvar 0 ${class}::optionExports exports

    set foo [$tkwidget ".ericFoo###"]
    # 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 } {
                # option is a synonym
................................................................................
		# Store the forward and backward mappings for this
		# option <-> realoption pair
                lappend classmap($option) $subpath "" $realopt
		set submap($realopt) $option
            }
        }
    }
    ::destroy $foo
}


# ----------------------------------------------------------------------------
#  Command Widget::bwinclude
#     Includes BWidget resources to BWidget widget.
#  class    class name of the BWidget
................................................................................
            set classopt($option) [list $type $value $ro $arg]
            continue
        }

        # retreive default value for TkResource
        if { [string equal $type "TkResource"] } {
            set tkwidget [lindex $arg 0]
	    set foo [$tkwidget ".ericFoo##"]
            set realopt  [lindex $arg 1]
            if { ![string length $realopt] } {
                set realopt $option
            }
            set tkoptions [_get_tkwidget_options $tkwidget]



            if { ![string length $value] } {
                # We initialize default value
		set ind [lsearch $tkoptions [list $realopt *]]
                set value [lindex [lindex $tkoptions $ind] end]
            }
	    set optionDbName ".[lindex [_configure_option $option ""] 0]"
	    option add *${class}${optionDbName} $value widgetDefault
	    set exports($option) $optionDbName
            set classopt($option) [list TkResource $value $ro \
		    [list $tkwidget $realopt]]
	    set optionClass($option) [lindex [$foo configure $realopt] 1]
	    ::destroy $foo
            continue
        }

	set optionDbName ".[lindex [_configure_option $option ""] 0]"
	option add *${class}${optionDbName} $value widgetDefault
	set exports($option) $optionDbName
        # for any other resource type, we keep original optdesc
        set classopt($option) [list $type $value $ro $arg]
    }
}




















proc Widget::define { class filename args } {
    variable ::BWidget::use




















    set use($class)      $args
    set use($class,file) $filename

    lappend use(classes) $class

    if {[set x [lsearch -exact $args "-classonly"]] > -1} {
	set args [lreplace $args $x $x]
    } else {
	interp alias {} ::${class} {} ${class}::create
	proc ::${class}::use {} {}








	bind $class <Destroy> [list Widget::destroy %W]
    }

    foreach class $args { ${class}::use }










}


proc Widget::create { class path {rename 1} } {
    if {$rename} { rename $path ::$path:cmd }






    proc ::$path { cmd args } \
    	[subst {return \[eval \[linsert \$args 0 ${class}::\$cmd [list $path]\]\]}]
    return $path
}


# ----------------------------------------------------------------------------
#  Command Widget::addmap
# ----------------------------------------------------------------------------
proc Widget::addmap { class subclass subpath options } {
    upvar 0 ${class}::opt classopt
    upvar 0 ${class}::optionExports exports
    upvar 0 ${class}::optionClass optionClass
    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
# ----------------------------------------------------------------------------
proc Widget::syncoptions { class subclass subpath options } {
    upvar 0 ${class}::sync classync

    foreach {option realopt} $options {
        if { ![string length $realopt] } {
            set realopt $option
        }
        set classync($option) [list $subpath $subclass $realopt]
    }
}


# ----------------------------------------------------------------------------
#  Command Widget::init
# ----------------------------------------------------------------------------
proc Widget::init { class path options } {
    variable _inuse
    variable _class
................................................................................
    }
    if {[info exists pathinit]} {
        unset pathinit
    }

    if {![string equal [info commands $path] ""]} { rename $path "" }

    ## Unset any variables used in this widget.






    foreach var [info vars ::${class}::$path:*] { unset $var }


    unset _class($path)
}


# ----------------------------------------------------------------------------
#  Command Widget::configure
................................................................................
                    # | ""       | *       | own              | window         | window  |
                    # | *        | :cmd    | own              | window         | current |
                    # | *        | *       | subwidget        | window.subpath | current |
                    if { [string length $subclass] && ! [string equal $subclass ":cmd"] } {
                        if { [string equal $subpath ":cmd"] } {
                            set subpath ""
                        }

                        set curval [${subclass}::cget $window$subpath $realopt]
                        ${subclass}::configure $window$subpath $realopt $newval
                    } else {
                        set curval [$window$subpath cget $realopt]
                        $window$subpath configure $realopt $newval
                    }
                }
            } else {
		set curval $pathopt($option)
................................................................................
	event generate $focus <<TraverseOut>>
    }
    focus $w

    event generate $w <<TraverseIn>>
}


























































# Widget::varForOption --
#
#	Retrieve a fully qualified variable name for the option specified.
#	If the option is not one for which a variable exists, throw an error 
#	(ie, those options that map directly to widget options).

#
# Arguments:
#	path	megawidget to get an option var for.
#	option	option to get a var for.
#
# Results:
#	varname	name of the variable, fully qualified, suitable for tracing.

proc Widget::varForOption {path option} {
    variable _class
    variable _optiontype

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

    if { ![info exists pathopt($option)] } {
	error "unable to find variable for option \"$option\""
    }
    set varname "::Widget::${class}::$path:opt($option)"
    return $varname
}

# Widget::getVariable --
#
#       Get a variable from within the namespace of the widget.
#
# Arguments:
................................................................................
#       newVarName	The variable name to refer to in the calling proc.
#
# Results:
#	Creates a reference to newVarName in the calling proc.
proc Widget::getVariable { path varName {newVarName ""} } {
    variable _class
    set class $_class($path)

    if {![string length $newVarName]} { set newVarName $varName }
    uplevel 1 [list upvar \#0 ${class}::$path:$varName $newVarName]

}

# Widget::options --
#
#       Return a key-value list of options for a widget.  This can
#       be used to serialize the options of a widget and pass them
#       on to a new widget with the same options.
................................................................................
}

proc Widget::theme {{bool {}}} {
    # Private, *experimental* API that may change at any time - JH
    variable _theme
    if {[llength [info level 0]] == 2} {
	# set theme-ability
	if {[catch {package require Tk 8.5a6}]
	    && [catch {package require tile 0.6}]
	    && [catch {package require tile 1}]} {
	    return -code error "BWidget's theming requires tile 0.6+"
	} else {
	    catch {style default BWSlim.Toolbutton -padding 0}
	}
	set _theme [string is true -strict $bool]
    }
    return $_theme
}






<







 







<







 







<





>
>
>


<
|






|
<












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


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


>


<
<
<
<
<
>
>
>
>

>
>
>



|
>
>
>
>
>
>
>
>
>
>





>
>
>
>
>
>

|










<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|
>
>
>
>
>
>
|
>







 







>
|
|







 







>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




|
>









|
<
<
<
<
<
<
<
<
<
<







 







>

<
>







 







|
|
<
|
<
<





133
134
135
136
137
138
139

140
141
142
143
144
145
146
...
184
185
186
187
188
189
190

191
192
193
194
195
196
197
...
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
...
509
510
511
512
513
514
515















516
517
518
519
520
521
522
...
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
...
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
....
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
....
1620
1621
1622
1623
1624
1625
1626
1627
1628

1629
1630
1631
1632
1633
1634
1635
1636
....
1701
1702
1703
1704
1705
1706
1707
1708
1709

1710


1711
1712
1713
1714
1715
    namespace eval $class {}
    upvar 0 ${class}::opt classopt
    upvar 0 ${class}::map classmap
    upvar 0 ${class}::map$subpath submap
    upvar 0 ${class}::optionExports exports


    # 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 } {
                # option is a synonym
................................................................................
		# Store the forward and backward mappings for this
		# option <-> realoption pair
                lappend classmap($option) $subpath "" $realopt
		set submap($realopt) $option
            }
        }
    }

}


# ----------------------------------------------------------------------------
#  Command Widget::bwinclude
#     Includes BWidget resources to BWidget widget.
#  class    class name of the BWidget
................................................................................
            set classopt($option) [list $type $value $ro $arg]
            continue
        }

        # retreive default value for TkResource
        if { [string equal $type "TkResource"] } {
            set tkwidget [lindex $arg 0]

            set realopt  [lindex $arg 1]
            if { ![string length $realopt] } {
                set realopt $option
            }
            set tkoptions [_get_tkwidget_options $tkwidget]
            set ind [lsearch $tkoptions [list $realopt *]]
            set optdesc [lindex $tkoptions $ind];
            set tkoptions [_get_tkwidget_options $tkwidget]
            if { ![string length $value] } {
                # We initialize default value

                set value [lindex $optdesc end]
            }
	    set optionDbName ".[lindex [_configure_option $option ""] 0]"
	    option add *${class}${optionDbName} $value widgetDefault
	    set exports($option) $optionDbName
            set classopt($option) [list TkResource $value $ro \
		    [list $tkwidget $realopt]]
	    set optionClass($option) [lindex $optdesc 1]

            continue
        }

	set optionDbName ".[lindex [_configure_option $option ""] 0]"
	option add *${class}${optionDbName} $value widgetDefault
	set exports($option) $optionDbName
        # for any other resource type, we keep original optdesc
        set classopt($option) [list $type $value $ro $arg]
    }
}


# ----------------------------------------------------------------------------
#  Command Widget::define
#  	Declares a new class and loads its dependencies.
#
# Arguments:
#	class		megawidget class
#	filename	file where the class resides
#	options    	The following options are supported:
#			-classonly	Prevents megawidget setup: creation of
#					megawidget alias, binding of the
#					<Destroy> event and stubbing of the
#					'use' procedure.
#			-namespace ns	Indicate the namespace where the
#					megawidget's procedures reside. Defaults
#					to ::${class}.
#	dependencies   	classes the class being defined depends on.
#
# ----------------------------------------------------------------------------
proc Widget::define { class filename args } {
    variable ::BWidget::use
    set classonly 0;
    set ns ::${class};
    for {set i 0; set n [llength $args]} {$i < $n} {incr i} {
	set option [lindex $args $i];
	switch -- $option {
	    -classonly {
		set classonly 1;
	    }
	    -namespace {
		incr i;
		set ns [lindex $args $i];
	    }
	    default {
		# stop processing options
		break;
	    }
	}
    }
    set args [lrange $args $i end]

    set use($class)      $args
    set use($class,file) $filename
    set use($class,namespace) $ns;
    lappend use(classes) $class






    # Make sure the class description namespace exists.
    namespace eval $class {}
    # Make sure the megawidget namespace exists.
    namespace eval $ns {}

    if {!$classonly} {
	interp alias {} ${ns} {} ${ns}::create
	proc ${ns}::use {} {}
	bind $class <Destroy> [list Widget::destroy %W]
    }

    foreach dep $args {
	if {![info exists use(${dep},namespace)]} {
	    # Lazy-loaded modules are not yet loaded (actually that seems to be
	    # the whole point of this 'use' mechanism.) so they have not configured
	    # a namespace. Use namespace=class convention. Note that the class MUST
	    # not be prefixed by ::.
	    ${dep}::use;
	} else {
	    $use(${dep},namespace)::use;
	}
    }
}


proc Widget::create { class path {rename 1} } {
    if {$rename} { rename $path ::$path:cmd }

    variable ::BWidget::use;
    set ns [expr {[info exists use(${class},namespace)]
		  ? $use(${class},namespace)
		  : $class}];

    proc ::$path { cmd args } \
	[subst {return \[eval \[linsert \$args 0 ${ns}::\$cmd [list $path]\]\]}]
    return $path
}


# ----------------------------------------------------------------------------
#  Command Widget::addmap
# ----------------------------------------------------------------------------
proc Widget::addmap { class subclass subpath options } {
    upvar 0 ${class}::opt classopt
    upvar 0 ${class}::optionExports exports

    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::init
# ----------------------------------------------------------------------------
proc Widget::init { class path options } {
    variable _inuse
    variable _class
................................................................................
    }
    if {[info exists pathinit]} {
        unset pathinit
    }

    if {![string equal [info commands $path] ""]} { rename $path "" }

    # Unset any variables used in this widget.
    # Guard, as some internal classes (Bitmap, LabelEntry, ListBox::Item,
    # NoteBook::Page, PanedWindow::Pane, ScrollableFrame, ScrollableFrame,
    # ScrollableFrame, Tree::Node, Wizard::Branch, Wizard::Step, Wizard::Widget)
    # are declared but not defined.
    if {[info exists ::BWidget::use(${class},namespace)]} {
	set ns $::BWidget::use(${class},namespace);
	foreach var [info vars ${ns}::${path}:*] { unset $var }
    }

    unset _class($path)
}


# ----------------------------------------------------------------------------
#  Command Widget::configure
................................................................................
                    # | ""       | *       | own              | window         | window  |
                    # | *        | :cmd    | own              | window         | current |
                    # | *        | *       | subwidget        | window.subpath | current |
                    if { [string length $subclass] && ! [string equal $subclass ":cmd"] } {
                        if { [string equal $subpath ":cmd"] } {
                            set subpath ""
                        }
                        set ns $::BWidget::use(${subclass},namespace);
                        set curval [${ns}::cget $window$subpath $realopt]
                        ${ns}::configure $window$subpath $realopt $newval
                    } else {
                        set curval [$window$subpath cget $realopt]
                        $window$subpath configure $realopt $newval
                    }
                }
            } else {
		set curval $pathopt($option)
................................................................................
	event generate $focus <<TraverseOut>>
    }
    focus $w

    event generate $w <<TraverseIn>>
}

# Widget::which --
#
#	Retrieve a fully qualified variable name for the specified option or
#	widget variable.
#
#	If the option is not one for which a variable exists, throw an error
#	(ie, those options that map directly to widget options).
#
#	For widget variables, return the fully qualified name even if the
#	variable had not been previously set, in order to allow adding variable
#	traces prior to their creation.
#
# Arguments:
#	path	megawidget to get an option var for.
#	type	either -option or -variable.
#	name    name of the option or widget variable.
#
# Results:
#	Fully qualified name of the variable for the option or the widget
#	variable.
#
proc Widget::which {path args} {
    switch -- [llength $args] {
	1 {
	    set type -option;
	    set name [lindex $args 0];
	}
	2 {
	    set type [lindex $args 0];
	    set name [lindex $args 1];
	}
	default {
	    return -code error "incorrect number of arguments";
	}
    }

    variable _class;
    set class $_class($path);

    switch -- $type {
	-option {
	    upvar 0 ${class}::$path:opt pathopt;

	    if { ![info exists pathopt($name)] } {
		error "unable to find variable for option \"$name\"";
	    }

	    return ::Widget::${class}::${path}:opt(${name});
	}
	-variable {
	    set ns $::BWidget::use(${class},namespace);
	    return ${ns}::${path}:${name};
	}
    }
}


# Widget::varForOption --
#
#	Retrieve a fully qualified variable name for the option specified.
#	If the option is not one for which a variable exists, throw an error 
#	(ie, those options that map directly to widget options) Superseded by
#       widget::which.
#
# Arguments:
#	path	megawidget to get an option var for.
#	option	option to get a var for.
#
# Results:
#	varname	name of the variable, fully qualified, suitable for tracing.

proc Widget::varForOption {path option} {
    return [::Widget::which $path -option $option];










}

# Widget::getVariable --
#
#       Get a variable from within the namespace of the widget.
#
# Arguments:
................................................................................
#       newVarName	The variable name to refer to in the calling proc.
#
# Results:
#	Creates a reference to newVarName in the calling proc.
proc Widget::getVariable { path varName {newVarName ""} } {
    variable _class
    set class $_class($path)
    set ns $::BWidget::use(${class},namespace);
    if {![string length $newVarName]} { set newVarName $varName }

    uplevel 1 [list ::upvar \#0 ${ns}::${path}:${varName} $newVarName]
}

# Widget::options --
#
#       Return a key-value list of options for a widget.  This can
#       be used to serialize the options of a widget and pass them
#       on to a new widget with the same options.
................................................................................
}

proc Widget::theme {{bool {}}} {
    # Private, *experimental* API that may change at any time - JH
    variable _theme
    if {[llength [info level 0]] == 2} {
	# set theme-ability
	if {[catch {package require Ttk}]
	    && [catch {package require tile 0.8}]} {

	    return -code error "BWidget's theming requires ttk/tile 0.8+"


	}
	set _theme [string is true -strict $bool]
    }
    return $_theme
}

Changes to xpm2image.tcl.

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
..
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
# ------------------------------------------------------------------------------
#
#  Copyright 1996 by Roger E. Critchlow Jr., San Francisco, California
#  All rights reserved, fair use permitted, caveat emptor.
#  [email protected]
# 
# ----------------------------------------------------------------------------




































































proc xpm-to-image { file } {
    set f [open $file]
    set string [read $f]
    close $f

    #
    # parse the strings in the xpm data
    #
    set xpm {}
    foreach line [split $string "\n"] {





        if {[regexp {^"([^\"]*)"} $line all meat]} {
            if {[string first XPMEXT $meat] == 0} {
                break
            }
            lappend xpm $meat
        }
    }
................................................................................
	    error "size line {$sizes} in $file did not compute"
    }

    #
    # extract the color definitions in the xpm data
    #
    foreach line [lrange $xpm 1 $data(ncolors)] {
        set colors [split $line \t]
        set cname  [lindex $colors 0]
        lappend data(cnames) $cname
        if { [string length $cname] != $data(chars_per_pixel) } {
            error "color definition {$line} in file $file has a bad size color name"
        }
        foreach record [lrange $colors 1 end] {
            set key [lindex $record 0]
            set color [string tolower [join [lrange $record 1 end] { }]]
            set data(color-$key-$cname) $color
            if { [string equal -nocase $color "none"] } {
                set data(transparent) $cname
            }
        }
        foreach key {c g g4 m} {
            if {[info exists data(color-$key-$cname)]} {
                set color $data(color-$key-$cname)
                set data(color-$cname) $color
                set data(cname-$color) $cname
                lappend data(colors) $color
                break
            }
        }
        if { ![info exists data(color-$cname)] } {
            error "color definition {$line} in $file failed to define a color"
        }
    }

    #
    # extract the image data in the xpm data
    #
    set image [image create photo -width $data(width) -height $data(height)]
    set y 0

    foreach line [lrange $xpm [expr {1+$data(ncolors)}] [expr {1+$data(ncolors)+$data(height)}]] {
        set x 0
        set pixels {}
        while { [string length $line] > 0 } {
            set pixel [string range $line 0 [expr {$data(chars_per_pixel)-1}]]













            set c $data(color-$pixel)
            if { [string equal $c none] } {
                if { [string length $pixels] } {
                    $image put [list $pixels] -to [expr {$x-[llength $pixels]}] $y
                    set pixels {}
                }
            } else {
                lappend pixels $c
            }
            set line [string range $line $data(chars_per_pixel) end]
            incr x



        }
        if { [llength $pixels] } {
            $image put [list $pixels] -to [expr {$x-[llength $pixels]}] $y
        }
        incr y
    }

    #
    # return the image
    #
    return $image
}








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





<




>
>
>
>
>







 







|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







>





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











>
>
>












<
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
...
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

# ------------------------------------------------------------------------------
#
#  Copyright 1996 by Roger E. Critchlow Jr., San Francisco, California
#  All rights reserved, fair use permitted, caveat emptor.
#  [email protected]
# 
# ----------------------------------------------------------------------------

proc _xpm-to-image_process_line { line } {
    upvar 1 data data
    set line [string map {"\t" " "} $line]

    set idx $data(chars_per_pixel)
    incr idx -1
    set cname [string range $line 0 $idx]


    set lend [string trim [string range $line $data(chars_per_pixel) end]]

    ## now replace multiple spaces with just one..
    while {-1 != [string first  "  " $lend]} {
        set lend [string map {"  " " "} $lend]
    }
    set cl [split $lend " "]

    set idx 0
    set clen [llength $cl]

    ## scan through the line, looking for records of type c, g or m
    while { $idx < $clen } {
        set key [lindex $cl $idx]
        if { [string equal $key {}] } {
            incr idx
            continue
        }

        while { ![string equal $key "c"]
                && ![string equal $key "m"]
                && ![string equal $key "g"]
                && ![string equal $key "g4"]
                && ![string equal $key ""]
        } { 
            incr idx
            set key [lindex $cl $idx]
        }

        incr idx
        set color [string tolower [lindex $cl $idx]]

        ## one file used opaque to mean black
        if { [string equal -nocase $color "opaque"] } {
            set color "black"
        }
        set data(color-$key-$cname) $color
        if { [string equal -nocase $color "none"] } {
            set data(transparent) $cname
        }
        incr idx
    }

    
    foreach key {c g g4 m} {
        if {[info exists data(color-$key-$cname)]} {
            set color $data(color-$key-$cname)
            set data(color-$cname) $color
            set data(cname-$color) $cname
            lappend data(colors) $color
            break
        }
    }
    if { ![info exists data(color-$cname)] } {
        error "color definition {$line} failed to define a color"
    }
}

proc xpm-to-image { file } {
    set f [open $file]
    set string [read $f]
    close $f


    # parse the strings in the xpm data
    #
    set xpm {}
    foreach line [split $string "\n"] {
        ## some files have blank lines in them, skip those
        ## also, some files indent each line with spaces - remove those
        set line [string trim $line]
        if { $line eq "" } { continue }

        if {[regexp {^"([^\"]*)"} $line all meat]} {
            if {[string first XPMEXT $meat] == 0} {
                break
            }
            lappend xpm $meat
        }
    }
................................................................................
	    error "size line {$sizes} in $file did not compute"
    }

    #
    # extract the color definitions in the xpm data
    #
    foreach line [lrange $xpm 1 $data(ncolors)] {
        _xpm-to-image_process_line $line

























    }

    #
    # extract the image data in the xpm data
    #
    set image [image create photo -width $data(width) -height $data(height)]
    set y 0
    set idx 0
    foreach line [lrange $xpm [expr {1+$data(ncolors)}] [expr {1+$data(ncolors)+$data(height)}]] {
        set x 0
        set pixels {}
        while { [string length $line] > 0 } {
            set pixel [string range $line 0 [expr {$data(chars_per_pixel)-1}]]
            ## see if they lied about the number of colors by not counting
            ## "none" in the color count entry
            set none 0
            if { ($idx == 0) && ([info exists data(cname-none)]) &&  \
                ![info exists data(color-$pixel)] } {
                ## it appears that way - process this line as another
                ## color entry
                _xpm-to-image_process_line $line
                incr idx
                set none 1
                break;
            }
            incr idx
            set c $data(color-$pixel)
            if { [string equal $c none] } {
                if { [string length $pixels] } {
                    $image put [list $pixels] -to [expr {$x-[llength $pixels]}] $y
                    set pixels {}
                }
            } else {
                lappend pixels $c
            }
            set line [string range $line $data(chars_per_pixel) end]
            incr x
        }
        if { $none == 1 } {
            continue
        }
        if { [llength $pixels] } {
            $image put [list $pixels] -to [expr {$x-[llength $pixels]}] $y
        }
        incr y
    }

    #
    # return the image
    #
    return $image
}